Solved

How to get this Virtual drives thingie working?

Posted on 2006-07-14
6
247 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
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 

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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
problem when i try to pack my dll file with upx 9 71
Machine not responding during CopyFile() 3 88
control image tags in a string ? 12 110
SUM 2 INTEGER ARRAYS INTO 1 10 93
Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
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…
This video shows how to remove a single email address from the Outlook 2010 Auto Suggestion memory. NOTE: For Outlook 2016 and 2013 perform the exact same steps. Open a new email: Click the New email button in Outlook. Start typing the address: …
A short film showing how OnPage and Connectwise integration works.

919 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