{$I-,F+,O+,X+}
unit DrvList;

interface

uses Objects, Drivers, Views, Dialogs, StrCol;

type
  PDriveListOptCheck = ^TDriveListOptCheck;
  TDriveListOptCheck = object(TCheckBoxes)
    procedure HandleEvent(var Event: TEvent); virtual;
    procedure Press(Item: Integer); virtual;
  end;

  PDriveListBox = ^TDriveListBox;
  TDriveListBox = object(TListBox)
    function GetText(Item: Integer; MaxLen: Integer): String; virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
  end;

  PUserDriveListViewer = ^TUserDriveListViewer;
  TUserDriveListViewer = object(TListViewer)
    procedure FocusItem(Item: Integer); virtual;
    function GetText(Item: Integer; MaxLen: Integer): String; virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
  end;

  PClassListViewer = ^TClassListViewer;
  TClassListViewer = object(TListViewer)
    function GetText(Item: Integer; MaxLen: Integer): String; virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
  end;

  PUserNetListViewer = ^TUserNetListViewer;
  TUserNetListViewer = object(TListViewer)
    procedure FocusItem(Item: Integer); virtual;
    function GetText(Item: Integer; MaxLen: Integer): String; virtual;
    procedure HandleEvent(var Event: TEvent); virtual;
    procedure UpdateCommands;
  end;

const
  RedisplayDriveDialog: Boolean = False;

  NetList: PStringsCollection = nil;

procedure DriveListDlg(Drive: Char);
function UserResourceLFNDisabled(const Path: String): Boolean;

implementation

uses Dos, App, MsgBox, EditMsg, DirPrim, Disks, HeapUMB, LFN,
  HistList, History, TPString, Consts, Commands, Defaults;

const
  LFNChar = #7;

procedure DrawDetectDriveStatus;
begin
  LogEvent := lcDiskRead;
  DrawStatusLine('Scanning available drives.');
end;

procedure DrawDetectNetStatus;
begin
  LogEvent := lcDiskRead;
  DrawStatusLine('Detecting available network resources.');
end;

function GetVolumeName(Drive: Char; Class: DiskClass;
  DisableFloppy: Boolean): String;
var
  B: Byte;
  S: String[11];
  SR: lSearchRec;
begin
  if DisableFloppy and (Class <= OtherFloppy) then S := ''
  else
  begin
    lFindFirst(Drive + ':\*.*', VolumeID, SR);
    lFindClose(SR);
    if DosError <> 0 then S := '' else S := SR.SR.Name;
    B := Pos('.', S);
    if B <> 0 then Delete(S, B, 1);
  end;
  GetVolumeName := S;
end;

function GetClusterSizeStr(Drive: Char; Class: DiskClass;
  DisableFloppy: Boolean): String;
var
  L: Longint;
  S: String[5];
begin
  if DisableFloppy and (Class <= OtherFloppy) then S := ''
  else
  begin
    CancelSysErrors := False;
    L := GetClusterSize(Byte(Drive) - $40);
    if CancelSysErrors then S := ''
    else Str(L, S);
  end;
  GetClusterSizeStr := S;
end;

function GetDiskSizeStr(Drive: Char; Class: DiskClass;
  DisableFloppy: Boolean): String;
var
  R: Real;
  S: String;
begin
  if DisableFloppy and (Class <= OtherFloppy) then S := ''
  else
  begin
    CancelSysErrors := False;
    R := FDiskSize(Byte(Drive) - $40);
    if CancelSysErrors or (R < 0) then S := ''
    else FormatFloatBytes(S, R, 1000000000);
  end;
  GetDiskSizeStr := S;
end;

function GetDiskFreeStr(Drive: Char; Class: DiskClass;
  DisableFloppy: Boolean): String;
var
  R: Real;
  S: String;
begin
  if DisableFloppy and (Class <= OtherFloppy) then S := ''
  else
  begin
    CancelSysErrors := False;
    R := FDiskFree(Byte(Drive) - $40);
    if CancelSysErrors or (R < 0) then S := ''
    else FormatFloatBytes(S, R, 1000000000);
  end;
  GetDiskFreeStr := S;
end;

function UserDefinedDriveListDialog: Word;
var
  W: Word;
  D: PDialog;
  UV: PUserDriveListViewer;
  Control: PView;
  R: TRect;
  SaveDrives: TUserDrives;
begin
  R.Assign(0, 0, 76, 21);
  D := New(PDialog, Init(R, 'User defined drive list'));
  with D^ do
  begin
    HelpCtx := hcUserDefinedDriveList;
    Options := Options or ofCentered;
    GrowMode := GrowMode + gfGrowHiY;

    R.Assign(28, 3, 29, Size.Y - 2);
    Control := New(PScrollBar, Init(R));
    Insert(Control);
    R.Assign(3, 3, 28, Size.Y - 2);
    UV := New(PUserDriveListViewer, Init(R, 1, nil, PScrollBar(Control)));
    UV^.GrowMode := gfGrowHiY;
    UV^.SetRange(26);
    Insert(UV);
    R.Assign(2, 2, 29, 3);
    Insert(New(PLabel, Init(R, '~D~rives                 LFN', UV)));

    R.Assign(Size.X - 4, 3, Size.X - 3, Size.Y - 2);
    Control := New(PScrollBar, Init(R));
    Insert(Control);
    R.Assign(53, 3, Size.X - 4, Size.Y - 2);
    Control := New(PClassListViewer, Init(
      R, 1, nil, PScrollBar(Control)));
    Control^.GrowMode := gfGrowHiY;
    PClassListViewer(Control)^.SetRange(16);
    Insert(Control);
    R.Assign(52, 2, Size.X - 3, 3);
    Insert(New(PLabel, Init(R, 'Disk c~l~asses', Control)));

    R.Assign(30, 3, 51, 5);
    Insert(New(PButton, Init(R, '~A~uto-detect disks',
      cmAutoDetect, bfNormal + bfBroadcast)));
    Inc(R.A.Y, 2); Inc(R.B.Y, 2);
    Insert(New(PButton, Init(R, 'Ä ~E~nable/Disable',
      cmToggleDrive, bfNormal + bfBroadcast)));
    Inc(R.A.Y, 2); Inc(R.B.Y, 2);
    Insert(New(PButton, Init(R, '~C~hange class ÄÄÄ',
      cmChangeClass, bfNormal + bfBroadcast)));
    Inc(R.A.Y, 2); Inc(R.B.Y, 2);
    Insert(New(PButton, Init(R, 'Ä~T~oggle LFN flag',
      cmToggleLFNFlag, bfNormal + bfBroadcast)));
    Inc(R.A.Y, 5); Inc(R.B.Y, 5);
    StandardOkButton(R, D);
    Inc(R.A.Y, 2); Inc(R.B.Y, 2);
    StandardCancelButton(R, D);
    Inc(R.A.Y, 2); Inc(R.B.Y, 2);
    StandardHelpButton(R, D);

    SelectNext(False);
    UV^.FocusItem(0);
  end;

  SaveDrives := UserDrives;
  W := Application^.ExecuteDialog(D, nil, True);
  if W = cmCancel then UserDrives := SaveDrives;
  Message(Application, evBroadcast, cmUpdateViews, nil);
  UserDefinedDriveListDialog := W;
end;

function UserDefinedNetListDialog: Word;
var
  W: Word;
  I: Integer;
  D: PDialog;
  UV: PUserNetListViewer;
  Control: PView;
  List: PStringsCollection;
  P: PString;
  R: TRect;
begin
  List := New(PStringsCollection, Init(NetList^.Count, 8));
  for I := 0 to NetList^.Count - 1 do
  begin
    P := NetList^.At(I);
{    if P <> nil then List^.Insert(NewStr(P^));}
    if P <> nil then List^.Insert(NewStrUMB(P^));
  end;

  R.Assign(0, 0, 71, 20);
  D := New(PDialog, Init(R, 'User defined network resource list'));
  with D^ do
  begin
    HelpCtx := hcUserDefinedNetList;
    Options := Options or ofCentered;
    GrowMode := GrowMode + gfGrowHiY;

    R.Assign(Size.X - 27, 3, Size.X - 26, Size.Y - 4);
    Control := New(PScrollBar, Init(R));
    Insert(Control);
    R.Assign(3, 3, Size.X - 27, Size.Y - 4);
    UV := New(PUserNetListViewer, Init(R, 1, nil, PScrollBar(Control)));
    UV^.GrowMode := gfGrowHiY;
    UV^.SetRange(NetList^.Count);
    Insert(UV);
    R.Assign(2, 2, Size.X - 26, 3);
    Insert(New(PLabel, Init(R,
      'Network ~r~esources                      LFN', UV)));

    R.Assign(Size.X - 25, 3, Size.X - 3, 5);
    Insert(New(PButton, Init(R, '~A~uto-detect',
      cmAutoDetect, bfNormal + bfBroadcast)));
    Inc(R.A.Y, 2); Inc(R.B.Y, 2);
    Insert(New(PButton, Init(R, '~M~odify',
      cmModifyItem, bfNormal + bfBroadcast)));
    Inc(R.A.Y, 2); Inc(R.B.Y, 2);
    Insert(New(PButton, Init(R, '~N~ew',
      cmNewItem, bfNormal + bfBroadcast)));
    Inc(R.A.Y, 2); Inc(R.B.Y, 2);
    Insert(New(PButton, Init(R, '~D~elete',
      cmDeleteItem, bfNormal + bfBroadcast)));
    Inc(R.A.Y, 2); Inc(R.B.Y, 2);
    Insert(New(PButton, Init(R, 'Ä ~E~nable/Disable',
      cmRunItem, bfNormal + bfBroadcast)));
    Inc(R.A.Y, 2); Inc(R.B.Y, 2);
    Insert(New(PButton, Init(R, 'Ä ~T~oggle LFN flag',
      cmReset, bfNormal + bfBroadcast)));
    Inc(R.A.Y, 2); Inc(R.B.Y, 2); Dec(R.B.X, 12);
    Insert(New(PButton, Init(R, ' ~U~p',
      cmHotKeyUp, bfNormal + bfBroadcast)));
    Inc(R.A.X, 12); Inc(R.B.X, 12);
    Insert(New(PButton, Init(R, ' Do~w~n',
      cmHotKeyDown, bfNormal + bfBroadcast)));

    R.Assign(3, Size.Y - 3, 13, Size.Y - 1);
    StandardOkButton(R, D);
    R.Assign(19, Size.Y - 3, 29, Size.Y - 1);
    StandardCancelButton(R, D);
    R.Assign(35, Size.Y - 3, 45, Size.Y - 1);
    StandardHelpButton(R, D);

    SelectNext(False);
    UV^.FocusItem(0);
  end;

  W := Application^.ExecuteDialog(D, nil, True);
  if W = cmCancel then
  begin
    NetList^.FreeAll;
    for I := 0 to List^.Count - 1 do
    begin
      P := List^.At(I);
{      if P <> nil then NetList^.Insert(NewStr(P^));}
      if P <> nil then NetList^.Insert(NewStrUMB(P^));
    end;
  end;
  Dispose(List, Done);
  Message(Application, evBroadcast, cmUpdateViews, nil);
  UserDefinedNetListDialog := W;
end;

procedure FillDriveList(Drive: Char; List: PCollection;
  var Sel: Integer; Quick: Boolean);
const
  DiskLen = 4;
  VolumeLen = 11;
  DescLen = 17;
  ClusterLen = 12;
  SizeLen = 11;
  FreeLen = 11;
var
  DisableFloppy: Boolean;
  C: Char;
  NumDrives: Byte;
  Class: DiskClass;
  P: PString;
  Drives: TDrivesArray;
  S: String;
begin
  List^.FreeAll;

  DisableFloppy := Quick or (GetShiftState and
    (kbAltShift * Byte(DriveListOptions and dlListNotLetter = 0) +
     kbCtrlShift + kbLeftShift + kbRightShift) = 0);

  DrawDetectDriveStatus;
  GetDrives(NumDrives, Drives);

  for C := 'A' to 'Z' do
    if Drives[C] = 1 then
    begin
      ClassifyDrive(C, Class);
      FailSysErrors := True;
      S :=
	Pad(C + ':', DiskLen) + '³' +
	Pad(GetVolumeName(C, Class, DisableFloppy), VolumeLen) + '³' +
	Pad(GetDiskDescription(Class), DescLen) + '³' +
	LeftPad(GetClusterSizeStr(C, Class, DisableFloppy), ClusterLen) + '³' +
	LeftPad(GetDiskSizeStr(C, Class, DisableFloppy), ClusterLen) + '³' +
	LeftPad(GetDiskFreeStr(C, Class, DisableFloppy), ClusterLen);
{      List^.Insert(NewStr(S));}
      List^.Insert(NewStrUMB(S));
      if C = Drive then Sel := List^.Count - 1;
    end;
  FailSysErrors := False;
end;

procedure AutoDetectUserDrives;
var
  C: Char;
  SaveOpt, NumDrives: Byte;
  Class: DiskClass;
  Drives: TDrivesArray;
begin
  DrawDetectDriveStatus;
  SaveOpt := DriveListOptions;
  DriveListOptions := 0;
  GetDrives(NumDrives, Drives);
  DriveListOptions := SaveOpt;

  FillChar(UserDrives, SizeOf(TUserDrives), 0);

  for C := 'A' to 'Z' do
    if Drives[C] = 1 then
    begin
      ClassifyDrive(C, Class);
      UserDrives[C] := (Byte(Class) + 1) or udEnabled;
    end;
end;

procedure TDriveListOptCheck.HandleEvent(var Event: TEvent);
begin
  Inherited HandleEvent(Event);
  if (Event.What = evBroadcast) and
     (Event.Command = cmUpdateViews) and
     (UserDrivesEnabled = 0) then 
  begin
    DriveListOptions := DriveListOptions and not dlGetFromUser;
    Value := DriveListOptions;
    DrawView;
  end;
end;

procedure TDriveListOptCheck.Press(Item: Integer);
var
  B, C: Boolean;
begin
  B := DriveListOptions and dlGetFromUser <> 0;
  C := DriveListOptions and dlUserResources <> 0;
  Inherited Press(Item);
  DriveListOptions := Value;
  if B <> (DriveListOptions and dlGetFromUser <> 0) then
    Message(Owner, evBroadcast, cmDriveOptions, nil);
  if C <> (DriveListOptions and dlUserResources <> 0) then
    Message(Owner, evBroadcast, cmNetListOptions, nil);
end;

function TDriveListBox.GetText(Item: Integer; MaxLen: Integer): String;
var
  P: PString;
begin
  P := List^.At(Item);
  if P = nil then GetText := '' else GetText := P^;
end;

procedure TDriveListBox.HandleEvent(var Event: TEvent);
var
  I: Integer;
  P: PString;

procedure RereadList;
begin
  FillDriveList(#0, List, Event.InfoInt, True);
  SetRange(List^.Count);
  FocusItem(0);
  DrawView;
  Message(Application, evBroadcast, cmReread, nil);
  RedisplayDriveDialog := True;
end;

begin
  Inherited HandleEvent(Event);
  if (Event.What = evKeyDown) and (Event.CharCode <> #0) then
  begin
    for I := 0 to List^.Count - 1 do
    begin
      P := List^.At(I);
      if (P <> nil) and
	 ((LatinChar(Event.CharCode) = P^[1]) or
	  (InterChar(Event.CharCode) = P^[1])) then
      begin
	FocusItem(I);
	DrawView;
	Event.What := evNothing;
	if DriveListOptions and dlListNotLetter <> 0 then
	  EndModal(cmOk);
	Break;
      end;
    end;
  end
  else if Event.What = evBroadcast then
    if Event.Command = cmListItemSelected then
    begin
      Event.What := evNothing;
      EndModal(cmOk);
    end
    else if Event.Command = cmUserOptions then
    begin
      Event.What := evNothing;
      if UserDefinedDriveListDialog = cmOk then RereadList;
    end
    else if Event.Command = cmUserPrograms then
    begin
      Event.What := evNothing;
      if UserDefinedNetListDialog = cmOk then RereadList;
    end
    else if Event.Command = cmDriveOptions then
    begin
      Event.What := evNothing;
      if (DriveListOptions and dlGetFromUser <> 0) and
	 (UserDrivesEnabled = 0) then
      begin
	Pending.What := evBroadcast;
	Pending.Command := cmUserOptions;
      end
      else RereadList;
    end
    else if Event.Command = cmNetListOptions then
    begin
      Event.What := evNothing;
      if (DriveListOptions and dlUserResources <> 0) and
	 (NetList^.Count = 0) then
      begin
	Pending.What := evBroadcast;
	Pending.Command := cmUserPrograms;
      end
      else RereadList;
    end;
end;

procedure DriveListDlg(Drive: Char);
type
  TListBoxData = record
    List: PCollection;
    Selection: Integer;
    Opt: Word;
  end;
var
  Y: Integer;
  DL: PDriveListBox;
  Control: PView;
  VBar: PScrollBar;
  D: PDialog;
  R: TRect;
  P: PString;
  Data: TListBoxData;
begin
  Data.List := New(PStringsCollection, Init(8, 8));
  Data.Selection := 0;
  Data.Opt := DriveListOptions;

  FillDriveList(Drive, Data.List, Data.Selection, False);

  if Data.List^.Count < 3 then Y := 14
  else Y := Data.List^.Count + 11;
  if Y > ScreenHeight - 6 then Y := ScreenHeight - 6;
  R.Assign(0, 0, 80, Y);
  D := New(PDialog, Init(R, 'Drive list'));
  with D^ do
  begin
    Options := Options or ofCentered;
    HelpCtx := hcDriveListDlg;

    R.Assign(Size.X - 3, 3, Size.X - 2, Size.Y - 8);
    VBar := New(PScrollBar, Init(R));
    Insert(VBar);

    R.Assign(2, 3, Size.X - 3, Size.Y - 8);
    DL := New(PDriveListBox, Init(R, 1, VBar));
    Insert(DL);

    R.Assign(2, 2, Size.X - 1, 3);
    Insert(New(PLabel, Init(R,
      '~D~isk Volume name Classification    Cluster size   Total size   Free space',
      DL)));

    R.Assign(2, Size.Y - 7, Size.X - 33, Size.Y - 4);
    Control := New(PDriveListOptCheck, Init(R,
      NewSItem('~O~pen Drive list instead of Drive letter',
      NewSItem('~G~et drives from User defined drive list',
      NewSItem('E~n~able User defined network resources', nil)))));
    Control^.EventMask := Control^.EventMask or evBroadcast;
    Insert(Control);
    R.Assign(1, Size.Y - 8, Size.X - 33, Size.Y - 7);
    Insert(New(PLabel, Init(R, 'Options', Control)));

    R.Assign(Size.X - 32, Size.Y - 7, Size.X - 2, Size.Y - 5);
    Insert(New(PButton, Init(R, '~U~ser defined drive list...',
      cmUserOptions, bfNormal + bfBroadcast)));
    R.Assign(Size.X - 32, Size.Y - 5, Size.X - 2, Size.Y - 3);
    Insert(New(PButton, Init(R, 'User defined ~r~esources...',
      cmUserPrograms, bfNormal + bfBroadcast)));

    R.Assign(2, Size.Y - 3, 12, Size.Y - 1);
    Insert(New(PButton, Init(R, '~S~elect', cmOK, bfDefault)));
    R.Assign(19, Size.Y - 3, 29, Size.Y - 1);
    StandardCancelButton(R, D);
    R.Assign(37, Size.Y - 3, 47, Size.Y - 1);
    StandardHelpButton(R, D);

    SelectNext(False);
  end;

  if Application^.ExecuteDialog(D, @Data, True) = cmOk then
  begin
    P := Data.List^.At(Data.Selection);
    if P <> nil then
    begin
      Pending.What := evKeyDown;
      Pending.CharCode := P^[1];
    end;
  end;

  Dispose(Data.List, Done);
end;

procedure TUserDriveListViewer.FocusItem(Item: Integer);
var
  Drive: Char;
begin
  Inherited FocusItem(Item);
  Drive := Char(Focused + Byte('A'));
  if UserDrives[Drive] and udEnabled <> 0 then
    Message(Owner, evBroadcast, cmUserDriveFocused,
      Pointer(GetUserDriveClass(Drive)));
end;

function TUserDriveListViewer.GetText(Item: Integer; MaxLen: Integer): String;
var
  Drive: Char;
  S: String;
begin
  Drive := Char(Item + Byte('A'));
  S := '  ' + Drive + ':³' +
    Pad(GetDiskDescription(GetUserDriveClass(Drive)), 17) + '³';
  if UserDrives[Drive] and udEnabled <> 0 then
  begin
    S[1] := 'û';
    if UserDrives[Drive] and udNoLFN = 0 then S := S + LFNChar;
  end;
  GetText := S;
end;

procedure TUserDriveListViewer.HandleEvent(var Event: TEvent);
var
  Drive: Char;
begin
  if Event.What = evKeyDown then
    if Event.KeyCode = kbIns then Event.KeyCode := kbSpace
    else if Event.KeyCode = kbGrayPlus then
    begin
      Event.What := evBroadcast;
      Event.Command := cmToggleLFNFlag;
    end;
  Inherited HandleEvent(Event);
  if Event.What = evBroadcast then
  begin
    Drive := Char(Focused + Byte('A'));
    if Event.Command = cmAutoDetect then AutoDetectUserDrives
    else if ((Event.Command = cmListItemSelected) and
	(Event.InfoPtr = @Self)) or
       (Event.Command =	cmToggleDrive) then
      UserDrives[Drive] := UserDrives[Drive] xor udEnabled
    else if Event.Command = cmChangeClassInfo then
      UserDrives[Drive] := Event.InfoByte or udEnabled
    else if Event.Command = cmToggleLFNFlag then
      UserDrives[Drive] := UserDrives[Drive] xor udNoLFN
    else Exit;
    if Event.Command <> cmAutoDetect then FocusItem(Focused + 1);
    DrawView;
    Event.What := evNothing;
  end;
end;

function IndexToClass(Index: Integer): DiskClass;
begin
  case Index of
    00: IndexToClass := Floppy360;
    01: IndexToClass := Floppy12;
    02: IndexToClass := Floppy720;
    03: IndexToClass := Floppy144;
    04: IndexToClass := Floppy288;
    05: IndexToClass := OtherFloppy;
    06: IndexToClass := Bernoulli;
    07: IndexToClass := HardDisk;
    08: IndexToClass := RamDisk;
    09: IndexToClass := SubstDrive;
    10: IndexToClass := NetDisk;
    11: IndexToClass := CDROMDisk;
    12: IndexToClass := DoubleSpaceDisk;
    13: IndexToClass := Stacker4Disk;
    14: IndexToClass := NetResource;
   else IndexToClass := UnknownDisk;
  end;
end;

function ClassToIndex(Class: DiskClass): Integer;
var
  I: Integer;
begin
  for I := 0 to 15 do
    if IndexToClass(I) = Class then
    begin
      ClassToIndex := I;
      Exit;
    end;
  ClassToIndex := 15;
end;

function TClassListViewer.GetText(Item: Integer; MaxLen: Integer): String;
begin
  GetText := GetDiskDescription(IndexToClass(Item));
end;

procedure TClassListViewer.HandleEvent(var Event: TEvent);
begin
  Inherited HandleEvent(Event);
  if Event.What = evBroadcast then
  begin
    if ((Event.Command = cmListItemSelected) and
	(Event.InfoPtr = @Self)) or
       (Event.Command = cmChangeClass) then
      Message(Owner, evBroadcast, cmChangeClassInfo,
	Pointer(Byte(IndexToClass(Focused)) + 1))
    else if Event.Command = cmUserDriveFocused then
      FocusItem(ClassToIndex(DiskClass(Event.InfoByte)))
    else Exit;
    Event.What := evNothing;
  end;
end;

function AutoDetectUserNet: Boolean;
var
  SaveOpt: Byte;
  I: Integer;
  List: PStringsCollection;
  P: PString;
begin
  AutoDetectUserNet := False;
  DrawDetectNetStatus;
  List := New(PStringsCollection, Init(8, 8));
  SaveOpt := DriveListOptions;
  DriveListOptions := 0;
  GetRedirDevices(List);
  DriveListOptions := SaveOpt;
  if List^.Count = 0 then MessageBox(
    ^C'No redirected network devices detected.',
    nil, mfInformation + mfOkButton)
  else
  begin
    NetList^.FreeAll;
    for I := 0 to List^.Count - 1 do
    begin
      P := List^.At(I);
      if P <> nil then NetList^.Insert(
{	NewStr(P^ + Char(udEnabled)))}
	NewStrUMB(P^ + Char(udEnabled)));
    end;
    AutoDetectUserNet := NetList^.Count <> 0;
  end;
  Dispose(List, Done);
end;

function NewNetListItem(Index: Integer; Edit: Boolean): Integer;
type
  TData = record
    Name: String[255];
    Opt: Word;
  end;
var
  C: Char;
  P: PString;
  D: PDialog;
  Control: PView;
  R: TRect;
  S: String[7];
  Data: TData;
begin
  NewNetListItem := -1;
  P := NetList^.At(Index);
  if (P = nil) or (Length(P^) <= 1) then Edit := False;
  if Edit then S := 'Modify' else S := 'New';
  R.Assign(0, 0, 63, 10);
  D := New(PDialog, Init(R, S + ' User defined network resource'));
  with D^ do
  begin
    Options := Options or ofCentered;
    HelpCtx := hcNewNetListItem;

    R.Assign(3, 3, Size.X - 6, 4);
    Control := New(PInputLine, Init(R, 255));
    Insert(Control);
    StandardHistory(Control, NetListHistoryId);
    R.Assign(2, 2, Size.X - 3, 3);
    Insert(New(PLabel, Init(R,
      'Network ~r~esource name (\\<servername>\<sharename>)',
      Control)));

    R.Assign(11, 5, Size.X - 3, 6);
    Control := New(PCheckBoxes, Init(R,
      NewSItem('Resource ~e~nabled',
      NewSItem('Win9~5~ LFN API enabled', nil))));
    Insert(Control);
    R.Assign(2, 5, 11, 6);
    Insert(New(PLabel, Init(R, 'Options', Control)));

    StandardButtonRow(D, True);
  end;
  if Edit then Data.Name := Copy(P^, 1, Length(P^) - 1)
  else Data.Name := HistoryStr(NetListHistoryId, 0);
  Data.Opt := 0;
  if Edit then C := P^[Length(P^)] else C := Char(udEnabled);
  if Byte(C) and udEnabled <> 0 then Data.Opt := Data.Opt or 1;
  if Byte(C) and udNoLFN = 0 then Data.Opt := Data.Opt or 2;
  if Application^.ExecuteDialog(D, @Data, True) = cmCancel then Exit;
  TrimSt(Data.Name);
  if Data.Name <> '' then
  begin
    C := #0;
    if Data.Opt and 1 <> 0 then Byte(C) := Byte(C) or udEnabled;
    if Data.Opt and 2 = 0 then Byte(C) := Byte(C) or udNoLFN;
{    P := NewStr(Data.Name + C);}
    P := NewStrUMB(Data.Name + C);
    if Edit then
    begin
      NetList^.AtFree(Index);
      NetList^.AtInsert(Index, P);
      NewNetListItem := Index;
    end
    else
    begin
      NetList^.Insert(P);
      NewNetListItem := NetList^.Count - 1;
    end;
  end;
end;

procedure TUserNetListViewer.FocusItem(Item: Integer);
begin
  Inherited FocusItem(Item);
  UpdateCommands;
end;

function TUserNetListViewer.GetText(Item: Integer; MaxLen: Integer): String;
var
  P: PString;
  S: String;
begin
  P := NetList^.At(Item);
  if (P = nil) or (Length(P^) <= 1) then GetText := ''
  else
  begin
    S := '  ' + Pad(TrimmedName(
      Copy(P^, 1, Length(P^) - 1), MaxLen - 6), MaxLen - 6) + '³';
    if Byte(P^[Length(P^)]) and udEnabled <> 0 then S[1] := 'û';
    if Byte(P^[Length(P^)]) and udNoLFN = 0 then S := S + LFNChar;
    GetText := S;
  end;
end;

procedure TUserNetListViewer.HandleEvent(var Event: TEvent);
var
  P: PString;

procedure ToggleFlag(Flag: Byte);
begin
  P := NetList^.At(Focused);
  if (P <> nil) and (Length(P^) > 1) then
    Byte(P^[Length(P^)]) := Byte(P^[Length(P^)]) xor Flag;
  if Focused < Range - 1 then FocusItem(Focused + 1);
end;

begin
  if Event.What = evKeyDown then
    if (Event.KeyCode = kbCtrlEnter) then
    begin
      Event.What := evBroadcast;
      Event.Command := cmModifyItem;
    end
    else if Event.KeyCode = kbIns then
    begin
      Event.What := evBroadcast;
      Event.Command := cmNewItem;
    end
    else if Event.KeyCode = kbGrayPlus then
    begin
      Event.What := evBroadcast;
      Event.Command := cmReset;
    end
    else if Event.KeyCode = kbDel then
    begin
      Event.What := evBroadcast;
      Event.Command := cmDeleteItem;
    end
    else if Event.KeyCode = kbCtrlUp then
    begin
      Event.What := evBroadcast;
      Event.Command := cmHotKeyUp;
    end
    else if Event.KeyCode = kbCtrlDn then
    begin
      Event.What := evBroadcast;
      Event.Command := cmHotKeyDown;
    end;
  Inherited HandleEvent(Event);
  if Event.What = evBroadcast then
  begin
    if (Event.Command = cmAutoDetect) and AutoDetectUserNet then
    begin
      SetRange(NetList^.Count);
      FocusItem(0);
    end
    else if (Event.Command = cmModifyItem) or
      (Event.Command = cmNewItem) then
    begin
      Event.InfoInt := NewNetListItem(
	Focused, Event.Command = cmModifyItem);
      if Event.InfoInt <> -1 then
      begin
	SetRange(NetList^.Count);
	FocusItem(Event.InfoInt);
      end;
    end
    else if (Event.Command = cmDeleteItem) and
      (Focused < Range) and (DeleteItemMsgBox = cmOk) then
    begin
      NetList^.AtFree(Focused);
      SetRange(NetList^.Count);
    end
    else if (Event.Command = cmHotKeyUp) or
      (Event.Command = cmHotKeyDown) then
	MoveListItem(@Self, NetList, Event.Command = cmHotKeyUp)
    else if ((Event.Command = cmListItemSelected) and
      (Event.InfoPtr = @Self)) or
      (Event.Command = cmRunItem) then ToggleFlag(udEnabled)
    else if Event.Command = cmReset then ToggleFlag(udNoLFN)
    else Exit;
    DrawView;
    UpdateCommands;
    Event.What := evNothing;
  end;
end;

procedure TUserNetListViewer.UpdateCommands;
const
  UpCommands = [cmHotKeyUp];
  DownCommands = [cmHotKeyDown];
begin
  if Range <> 0 then EnableCommands(
    ModifyCommands + DeleteCommands + RunItemCommands + ResetCommands)
  else DisableCommands(
    ModifyCommands + DeleteCommands + RunItemCommands + ResetCommands);
  if Focused <> 0 then EnableCommands(UpCommands)
  else DisableCommands(UpCommands);
  if Focused < Range - 1 then EnableCommands(DownCommands)
  else DisableCommands(DownCommands);
end;

function UserResourceLFNDisabled(const Path: String): Boolean;
var
  I: Integer;
  P: PString;
begin
  for I := 0 to NetList^.Count - 1 do
  begin
    P := NetList^.At(I);
    if (P <> nil) and (Length(P^) > 1) and
       (Byte(P^[Length(P^)]) and udNoLFN <> 0) and
       (Byte(P^[Length(P^)]) and udEnabled <> 0) and
       (UCPos(AddedSlash(Copy(P^, 1, Length(P^) - 1)),
	AddedSlash(Path)) = 1) then
    begin
      UserResourceLFNDisabled := True;
      Exit;
    end;
  end;
  UserResourceLFNDisabled := False;
end;

end.