Solved

How to get this Virtual drives thingie working?

Posted on 2006-07-14
6
246 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
Why You Should Analyze Threat Actor TTPs

After years of analyzing threat actor behavior, it’s become clear that at any given time there are specific tactics, techniques, and procedures (TTPs) that are particularly prevalent. By analyzing and understanding these TTPs, you can dramatically enhance your security program.

 

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

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
Illustrator's Shape Builder tool will let you combine shapes visually and interactively. This video shows the Mac version, but the tool works the same way in Windows. To follow along with this video, you can draw your own shapes or download the file…
This video gives you a great overview about bandwidth monitoring with SNMP and WMI with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're looking for how to monitor bandwidth using netflow or packet s…

760 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

22 Experts available now in Live!

Get 1:1 Help Now