unit myShare;

interface

uses
  Unicode, Dockable,
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ShellCtrls, StdCtrls, ExtCtrls, ImgList, RxHook, Menus;

type
  TfrmMyShare = class(TfrmDockable)
    Panel1: TPanel;
    ShlLVDetail: TShellListView;
    Panel2: TPanel;
    Splitter1: TSplitter;
    Panel3: TPanel;
    Button1: TButton;
    ImageList1: TImageList;
    RxWindowHook1: TRxWindowHook;
    RxWindowHook2: TRxWindowHook;
    Button2: TButton;
    Label1: TLabel;
    lbstate: TLabel;
    Timer1: TTimer;
    Image1: TImage;
    Label2: TLabel;
    pnllist: TPanel;
    ShlTVDir: TShellTreeView;
    Splitter2: TSplitter;
    Panel4: TPanel;
    lstShare: TListBox;
    Label3: TLabel;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure RxWindowHook1BeforeMessage(Sender: TObject;
      var Msg: TMessage; var Handled: Boolean);
    procedure ShlTVDirMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button1Click(Sender: TObject);
    procedure RxWindowHook2BeforeMessage(Sender: TObject;
      var Msg: TMessage; var Handled: Boolean);
    procedure FormDestroy(Sender: TObject);
    procedure ShlTVDirMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ShlTVDirExpanded(Sender: TObject; Node: TTreeNode);
    procedure ShlTVDirEditing(Sender: TObject; Node: TTreeNode;
      var AllowEdit: Boolean);
    procedure ShlLVDetailEditing(Sender: TObject; Item: TListItem;
      var AllowEdit: Boolean);
    procedure ShlTVDirKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ShlLVDetailContextPopup(Sender: TObject; MousePos: TPoint;
      var Handled: Boolean);
    procedure ShlTVDirChange(Sender: TObject; Node: TTreeNode);
    procedure Button2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Label2Click(Sender: TObject);
    procedure lstShareClick(Sender: TObject);
    procedure lstShareKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure N1Click(Sender: TObject);
    procedure PopupMenu1Popup(Sender: TObject);
  private
    { Private declarations }
    procedure InvokeContextMenu(MenuOwner: TWinControl; AFolder: TShellFolder; X, Y: Integer);

    procedure ChangeTreeNodeState(Node: TTreeNode; State: Integer);
    function GetShareState(Path: WideString): Integer;
    procedure ToggleShare(Path: WideString);
    procedure ClearSubShare(Path: WideString);
    procedure ChangeTVState;
    procedure ChangeLvState;
    procedure refreshstate;
  public
    { Public declarations }
    ShareDirs: Twidestrings;
    procedure InitHddTree;
  end;

var
  frmMyShare: TfrmMyShare;

procedure ShowMyShare;

implementation

uses
  ShellConsts, shellapi, shlobj, typinfo, ComObj, CommCtrl, ShareUnit,
  Options, RiserWindow, Jabber1;
{$R *.dfm}
Type
  TShareShellComboBox = class(TShellComboBox);
  TShareShellTreeView = class(TShellTreeView);

var
  DesktopFolder: TShellFolder = nil;
  ICM: IContextMenu = nil;
  ICM2: IContextMenu2 = nil;

function DesktopShellFolder: IShellFolder;
begin
  OleCheck(SHGetDesktopFolder(Result));
end;

function GetIShellFolder(IFolder: IShellFolder; PIDL: PItemIDList;
  Handle: THandle = 0): IShellFolder;
var
  HR: HResult;
begin
  if Assigned(IFolder) then
  begin
    HR := IFolder.BindToObject(PIDL, nil, IID_IShellFolder, Pointer(Result));
    if HR <> S_OK then
      IFolder.GetUIObjectOf(Handle, 1, PIDL, IID_IShellFolder, nil, Pointer(Result));
    if HR <> S_OK then
      IFolder.CreateViewObject(Handle, IID_IShellFolder, Pointer(Result));
  end;
  if not Assigned(Result) then
    DesktopShellFolder.BindToObject(PIDL, nil, IID_IShellFolder, Pointer(Result));
end;


function CreateRootFromPIDL(Value: PItemIDList): TShellFolder;
var
  SF: IShellFolder;
begin
  SF := GetIShellFolder(DesktopShellFolder, Value);
  if SF = nil then SF := DesktopShellFolder;
  //special case - Desktop folder can't bind to itself.
  Result := TShellFolder.Create(DesktopFolder, Value, SF);
end;


function CreateFolder(RootFolder: TShellFolder; OldRoot: TRoot;
  var NewRoot: TRoot): TShellFolder;
var
  P: PWideChar;
  NewPIDL: PItemIDList;
  NumChars,
    Flags,
    HR: LongWord;
  ErrorMsg: string;
begin
  HR := S_FALSE;
  if Length(NewRoot) > 0 then
  begin
    if NewRoot[Length(NewRoot)] = ':' then NewRoot := NewRoot + '\';
    NumChars := Length(NewRoot);
    Flags := 0;
    P := StringToOleStr(NewRoot);
    HR := DesktopShellFolder.ParseDisplayName(0, nil, P, NumChars, NewPIDL, Flags);
  end;

  if HR <> S_OK then
  begin
    { TODO : Remove the next line? }
    // Result := RootFolder;
//    ErrorMsg := Format( SErrorSettingPath, [ NewRoot ] );
    NewRoot := OldRoot;
    ShowRiserWindow(nil, ErrorMsg, ico_info);
    abort;
    //raise Exception.Create( ErrorMsg );
  end;

  Result := CreateRootFromPIDL(NewPIDL);
  if Assigned(RootFolder) then RootFolder.Free;
end;

function StrRetToString(PIDL: PItemIDList; StrRet: TStrRet; Flag: string = ''): string;
var
  P: PChar;
begin
  case StrRet.uType of
    STRRET_CSTR:
      SetString(Result, StrRet.cStr, lStrLen(StrRet.cStr));
    STRRET_OFFSET:
      begin
        P := @PIDL.mkid.abID[StrRet.uOffset - SizeOf(PIDL.mkid.cb)];
        SetString(Result, P, PIDL.mkid.cb - StrRet.uOffset);
      end;
    STRRET_WSTR:
      if Assigned(StrRet.pOleStr) then
        Result := StrRet.pOleStr
      else
        Result := '';
  end;
  { This is a hack bug fix to get around Windows Shell Controls returning
    spurious "?"s in date/time detail fields }
  if (Length(Result) > 1) and (Result[1] = '?') and (Result[2] in ['0'..'9']) then
    Result := StringReplace(Result, '?', '', [rfReplaceAll]);
end;

function GetDisplayName(Parentfolder: IShellFolder; PIDL: PItemIDList;
  Flags: DWORD): string;
var
  StrRet: TStrRet;
begin
  Result := '';
  if ParentFolder = nil then
  begin
    Result := 'parentfolder = nil'; { Do not localize }
    exit;
  end;
  FillChar(StrRet, SizeOf(StrRet), 0);
  ParentFolder.GetDisplayNameOf(PIDL, Flags, StrRet);
  Result := StrRetToString(PIDL, StrRet);
  { TODO 2 -oMGD -cShell Controls : Remove this hack (on Win2k, GUIDs are returned for the
PathName of standard folders)}
  if (Pos('::{', Result) = 1) then
    Result := GetDisplayName(ParentFolder, PIDL, SHGDN_NORMAL);
end;

function GetShellImage(PIDL: PItemIDList; Large, Open: Boolean): Integer;
var
  FileInfo: TSHFileInfo;
  Flags: Integer;
begin
  Flags := SHGFI_PIDL or SHGFI_SYSICONINDEX;
  if Open then Flags := Flags or SHGFI_OPENICON;
  if Large then Flags := Flags or SHGFI_LARGEICON
  else Flags := Flags or SHGFI_SMALLICON;
  SHGetFileInfo(PChar(PIDL),
    0,
    FileInfo,
    SizeOf(FileInfo),
    Flags);
  Result := FileInfo.iIcon;
end;

procedure ShowMyShare;
begin
  with TfrmMyShare.Create(Application) do
  try
    showmodal;
  finally
    free;
  end;
end;

procedure TfrmMyShare.FormCreate(Sender: TObject);
begin
  ShareDirs := GetShareDirs;
  lstShare.Items.BeginUpdate;
  lstShare.Items.Assign(ShareDirs);
  lstShare.Items.EndUpdate;
  if ShareDirs = nil then
    ShareDirs := TWideStringList.Create;
  ShlTVDir.ShowRoot := true;
  InitHddTree;
end;

procedure TfrmMyShare.InitHddTree;
var
  Folder: TShellFolder;
  Node: TTreeNode;
  Root: TRoot;
  i: Char;
  D: Cardinal;
begin
  ShlTVDir.Items.Item[0].Collapse(false);
  ShlTVDir.Items.Clear;
//  ShlTVDir.StateImages := ImageList1;
//  TreeView_SetImageList(ShlTVDir.Handle,TVSIL_STATE,ImageList1.Handle);
  D := GetLogicalDrives;
  D := D shr 2;
  for i := 'C' to 'Z' do
  begin
    if (D and 1) = 1 then
    begin
      Root := i + ':\';
      Folder := CreateFolder(nil, '', Root);
      Node := ShlTVDir.Items.Add(nil, '');
      with Node do
      begin
        Data := TShellFolder.Create(nil, Folder.AbsoluteID, Folder.ShellFolder);
        Text := GetDisplayName(DesktopShellFolder,
          TShellFolder(Data).AbsoluteID,
          SHGDN_NORMAL);
        Node.ImageIndex := GetShellImage(TShellFolder(Node.Data).AbsoluteID, False, False);
        Node.SelectedIndex := GetShellImage(TShellFolder(Node.Data).AbsoluteID, False, False);
        Node.HasChildren := TShellFolder(Node.Data).SubFolders;
        Node.StateIndex := GetShareState(TShellFolder(Node.Data).PathName);
      end;
      Folder.Free;
    end;
    D := D shr 1;
  end;
end;

procedure TfrmMyShare.InvokeContextMenu(MenuOwner: TWinControl;
  AFolder: TShellFolder; X, Y: Integer);
var
  PIDL: PItemIDList;
  CM: IContextMenu;
  Menu: HMenu;
  ICI: TCMInvokeCommandInfo;
  P: TPoint;
  Command: LongBool;
  ICmd: integer;
  ZVerb: array[0..255] of char;
  Verb: string;
  Handled: boolean;
  SCV: IShellCommandVerb;
  HR: HResult;
  Pop: TPopupMenu;
begin
  if AFolder = nil then Exit;
  PIDL := AFolder.RelativeID;
  AFolder.ParentShellFolder.GetUIObjectOf(MenuOwner.Handle, 1, PIDL, IID_IContextMenu, nil, CM);
  if CM = nil then Exit;
  P.X := X;
  P.Y := Y;

  Windows.ClientToScreen(MenuOwner.Handle, P);
  Pop := TPopupMenu.Create(self);
  pop.Items.add(TMenuItem.Create(nil));
  pop.Items.add(TMenuItem.Create(nil));
  pop.Items[1].Caption := '-';

  case GetShareState(AFolder.PathName) of
    1: pop.Items[0].Caption := '设为共享';
    2: pop.Items[0].Caption := '取消共享';
  else
    begin
      pop.Items[0].Visible := false;
      pop.Items[1].Visible := false;
    end;
  end;   {}


  Menu := Pop.Handle;
  try
    if AFolder.IsFolder then
      CM.QueryContextMenu(Menu, 2, 1, $7FFF, CMF_EXPLORE or CMF_CANRENAME)
    else
      CM.QueryContextMenu(Menu, 0, 1, $7FFF, CMF_EXPLORE or CMF_CANRENAME);

    CM.QueryInterface(IID_IContextMenu2, ICM2); //To handle submenus. {}
    try
      Command := TrackPopupMenu(Menu, TPM_LEFTALIGN or TPM_LEFTBUTTON or TPM_RIGHTBUTTON or
        TPM_RETURNCMD, P.X, P.Y, 0, MenuOwner.Handle, nil);
    finally
      ICM2 := nil;
    end;

    if Command then
    begin
      ICmd := LongInt(Command) - 1;
      if Icmd = pop.Items[0].Command - 1 then
      begin
        ToggleShare(AFolder.PathName);
        exit;
      end;
      HR := CM.GetCommandString(ICmd, GCS_VERBA, nil, ZVerb, SizeOf(ZVerb));
      Verb := StrPas(ZVerb);
      Handled := False;
      if Supports(Owner, IShellCommandVerb, SCV) then
      begin
        HR := 0;
        SCV.ExecuteCommand(Verb, Handled);
      end;

      if not Handled then
      begin
        FillChar(ICI, SizeOf(ICI), #0);
        with ICI do
        begin
          cbSize := SizeOf(ICI);
          hWND := MenuOwner.Handle;
          lpVerb := MakeIntResource(ICmd);
          nShow := SW_SHOWNORMAL;
        end;
        HR := CM.InvokeCommand(ICI);
      end;

      if Assigned(SCV) then
        SCV.CommandCompleted(Verb, HR = S_OK);
    end;
  finally
    Pop.Free;
//    DestroyMenu(Menu);
  end;
end;

procedure TfrmMyShare.RxWindowHook1BeforeMessage(Sender: TObject;
  var Msg: TMessage; var Handled: Boolean);
begin
  Handled := false;
  case Msg.Msg of
    WM_INITMENUPOPUP,
      WM_DRAWITEM,
      WM_MENUCHAR,
      WM_MEASUREITEM:
      if Assigned(ICM2) then
      begin
        ICM2.HandleMenuMsg(msg.Msg, msg.wParam, msg.lParam);
        msg.Result := 0;
        Handled := true;
      end;
    WM_LBUTTONDBLCLK:
      Handled := true;
  end;
end;

procedure TfrmMyShare.ShlTVDirMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if (Button = mbRight) and (ShlTVDir.SelectedFolder <> nil) then
    InvokeContextMenu(ShlTVDir, ShlTVDir.SelectedFolder, x, y);
end;

procedure TfrmMyShare.Button1Click(Sender: TObject);
begin
  TBuildShareListThread.Create;
//  BuildShareList;
  close;
end;

procedure TfrmMyShare.RxWindowHook2BeforeMessage(Sender: TObject;
  var Msg: TMessage; var Handled: Boolean);
begin
  Handled := false;
  case Msg.Msg of
    WM_INITMENUPOPUP,
      WM_DRAWITEM,
      WM_MENUCHAR,
      WM_MEASUREITEM:
      if Assigned(ICM2) then
      begin
        ICM2.HandleMenuMsg(msg.Msg, msg.wParam, msg.lParam);
        msg.Result := 0;
        Handled := False;
      end;
  end;
end;

procedure TfrmMyShare.FormDestroy(Sender: TObject);
begin
  if ShareDirs <> nil then
  begin
    SaveShareDirs(ShareDirs);
    FreeAndNil(ShareDirs);
  end;
end;

procedure TfrmMyShare.ChangeTreeNodeState(Node: TTreeNode; State: Integer);
var
  i: integer;
  Path: widestring;
begin
  if State = 2 then
  begin
    Path := TShellFolder(Node.Data).PathName;
    if path[length(path)] <> '\' then
      path := Path + '\';
    ClearSubShare(path);
    ShareDirs.Add(path);
    lstShare.Items.BeginUpdate;
    lstShare.Items.Assign(ShareDirs);
    lstShare.Items.EndUpdate;
    SaveShareDirs(ShareDirs);
  end;

  if (State = 1) and (Node.StateIndex = 2) then
  begin
    Path := TShellFolder(Node.Data).PathName;
    if path[length(path)] <> '\' then
      path := Path + '\';
    i := ShareDirs.IndexOf(path);
    if I >= 0 then
      ShareDirs.Delete(i);
    lstShare.Items.BeginUpdate;
    lstShare.Items.Assign(ShareDirs);
    lstShare.Items.EndUpdate;
    SaveShareDirs(ShareDirs);
  end;

  Node.StateIndex := State;
  for i := 0 to Node.Count - 1 do
    case Node.StateIndex of
      2: ChangeTreeNodeState(Node.Item[i], 0);
    else
      ChangeTreeNodeState(Node.Item[i], state);
    end;
end;

procedure TfrmMyShare.ShlTVDirMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  N: TTreeNode;
begin
  if Button <> mbleft then exit;

  N := ShlTVDir.GetNodeAt(X, Y);
  if N = nil then exit;

  if not (N.StateIndex in [1, 2]) then exit;

  if (X < (ImageList1.Width + (N.Level + 1) * 19)) and
    (X > ((N.Level + 1) * 19)) then
  begin
    ChangeTreeNodeState(N, (N.StateIndex mod 2) + 1);
    TBuildShareListThread.Create;
    refreshstate;
    Timer1.Enabled := true;
  end;

  if (X - N.Level * 19) in [0..19] then
  begin
//    if N.Expanded then
//      N.Collapse(false)
//    else
//      N.Expand(false);
//    N.Expanded := not N.Expanded;
  end;
end;

function TfrmMyShare.GetShareState(Path: WideString): Integer;
var
  i: Integer;
begin
  if path[length(path)] <> '\' then
    path := Path + '\';
  if ShareDirs = nil then exit;
  Result := 1; //unshared;
  for i := 0 to ShareDirs.Count - 1 do
  begin
    if Pos(ShareDirs[i], Path) = 1 then //found!
      if length(Path) > length(ShareDirs[i]) then
        Result := 0 //parent shared!
      else
        Result := 2 //shared!
  end;
end;

procedure TfrmMyShare.ShlTVDirExpanded(Sender: TObject; Node: TTreeNode);
begin
  ChangeTVState;
//  ChangeTreeNodeState(Node,Node.StateIndex);
end;

procedure TfrmMyShare.ShlTVDirEditing(Sender: TObject; Node: TTreeNode;
  var AllowEdit: Boolean);
begin
  AllowEdit := false;
end;

procedure TfrmMyShare.ShlLVDetailEditing(Sender: TObject; Item: TListItem;
  var AllowEdit: Boolean);
begin
  AllowEdit := false;
end;

procedure TfrmMyShare.ShlTVDirKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  N: TTreeNode;
begin
  if Key = VK_SPACE then
  begin
    N := ShlTVDir.Selected;
    if N <> nil then
    begin
      ChangeTreeNodeState(N, (N.StateIndex mod 2) + 1);
      TBuildShareListThread.Create;
      refreshstate;
      Timer1.Enabled := true;
    end;
  end;
end;

procedure TfrmMyShare.ShlLVDetailContextPopup(Sender: TObject;
  MousePos: TPoint; var Handled: Boolean);
begin
//  MousePos := ShlLVDetail.ScreenToClient(MousePos);
  InvokeContextMenu(ShlLVDetail, ShlLVDetail.SelectedFolder, MousePos.X, MousePos.Y);
  Handled := true;
end;

procedure TfrmMyShare.ShlTVDirChange(Sender: TObject; Node: TTreeNode);
begin
  ChangeLvState;
end;

procedure TfrmMyShare.ChangeLvState;
var
  i: Integer;
begin
  for i := 0 to ShlLVDetail.Items.Count - 1 do
    ShlLVDetail.Items[i].StateIndex := GetShareState(ShlLVDetail.Folders[i].PathName);
end;

procedure TfrmMyShare.ToggleShare(Path: WideString);
var
  Index: Integer;
begin
  if path[length(path)] <> '\' then
    path := Path + '\';
  if ShareDirs = nil then exit;
  Index := ShareDirs.IndexOf(Path);
  if Index < 0 then
  begin
    ClearSubShare(Path);
    ShareDirs.Add(Path);
  end
  else
    ShareDirs.Delete(Index);
  ChangeTVState;
  ChangeLvState;
  lstShare.Items.BeginUpdate;
  lstShare.Items.Assign(ShareDirs);
  lstShare.Items.EndUpdate;
  SaveShareDirs(ShareDirs);
end;

procedure TfrmMyShare.ChangeTVState;
var
  Node: TTreeNode;
begin
  Node := ShlTVDir.Items[0];
  if Node = nil then exit;
  repeat
    Node.StateIndex := GetShareState(TShellFolder(Node.Data).PathName);
    Node := Node.GetNextVisible;
  until Node = nil;
end;

procedure TfrmMyShare.ClearSubShare(Path: WideString);
var
  i: Integer;
begin
  if path[length(path)] <> '\' then
    path := Path + '\';
  for i := ShareDirs.Count - 1 downto 0 do
    if Pos(Path, ShareDirs[0]) = 1 then
      ShareDirs.Delete(i);
  lstShare.Items.BeginUpdate;
  lstShare.Items.Assign(ShareDirs);
  lstShare.Items.EndUpdate;
end;

procedure TfrmMyShare.Button2Click(Sender: TObject);
begin
  StartOptions(3);
end;

procedure TfrmMyShare.Timer1Timer(Sender: TObject);
begin
  inherited;
  refreshstate;
  Timer1.Enabled := ShareListBuilding or assigned(curBSLThread);
  if not Timer1.Enabled then
  begin
    if Timer1.tag = 0 then
    begin
      Timer1.Enabled := true;
      Timer1.tag := 1;
    end;
    exit;
  end;
  Timer1.tag := 0;
end;

procedure TfrmMyShare.refreshstate;
begin
  lbstate.Caption := '已经共享了' + inttostr(ShareDirCount) + '个目录,' +
    inttostr(ShareFileCount) + '个文件,共' + inttostr(ShareFileSzize) + '字节';
end;

procedure TfrmMyShare.FormShow(Sender: TObject);
begin
  inherited;
  refreshstate;
end;

procedure TfrmMyShare.Label2Click(Sender: TObject);
begin
  StartOptions(4);
end;

procedure TfrmMyShare.lstShareClick(Sender: TObject);
begin
  inherited;
  if lstShare.ItemIndex<0 then exit;
  TShareShellTreeView(ShlTVDir).SetPath(lstShare.Items[lstShare.ItemIndex]);
{  ShellComboBox1.Root := ExtractFileDrive(lstShare.Items[lstShare.ItemIndex]);
  ShellComboBox1.Path := lstShare.Items[lstShare.ItemIndex];
//  TShareShellComboBox(ShellComboBox1).Change;
  ShellComboBox1.ShellTreeView := ShlTVDir;
//  ShellComboBox1.ShellTreeView := nil;{}
end;

procedure TfrmMyShare.lstShareKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  inherited;
  if lstShare.ItemIndex<0 then exit;
  TShareShellTreeView(ShlTVDir).SetPath(lstShare.Items[lstShare.ItemIndex]);
  TBuildShareListThread.Create;
  refreshstate;
  Timer1.Enabled := true;
end;

procedure TfrmMyShare.N1Click(Sender: TObject);
begin
  inherited;
  if lstShare.ItemIndex<0 then exit;
  ToggleShare(lstShare.Items[lstShare.ItemIndex])
end;

procedure TfrmMyShare.PopupMenu1Popup(Sender: TObject);
begin
  inherited;
  N1.Enabled := lstShare.ItemIndex>=0;
end;

end.
