cxshellcommon.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 2,198 行 · 第 1/5 页

  end;
end;

function cxFileTimeToDateTime(fTime:FILETIME):TDateTime;
var
  LocalTime:TFileTime;
  Age:Integer;
begin
  FileTimeToLocalFileTime(FTime,LocalTime);
  if FileTimeToDosDateTime(LocalTime,LongRec(Age).Hi,LongRec(Age).Lo) then
     Result:=FileDateToDateTime(Age)
  else
     Result:=-1;
end;

function cxMalloc: IMalloc;
begin
  if FcxMalloc = nil then
    SHGetMalloc(FcxMalloc);
  Result := FcxMalloc;
end;

procedure TcxContextMenuMessageWindow.WndProc(var Message: TMessage);
begin
  case Message.Msg of
    WM_INITMENUPOPUP:
      begin
        ContextMenu.HandleMenuMsg(Message.Msg, Message.wParam, Message.lParam);
        Message.Result := 0;
      end;
    WM_DRAWITEM, WM_MEASUREITEM:
      begin
        ContextMenu.HandleMenuMsg(Message.Msg, Message.wParam, Message.lParam);
        Message.Result := 1;
      end;
    else
      inherited WndProc(Message);
  end;
end;

function CreateCallbackWnd(AContextMenu: IContextMenu2): TcxContextMenuMessageWindow;
begin
  Result := TcxContextMenuMessageWindow.Create;
  Result.ContextMenu := AContextMenu;
end;

procedure DisplayContextMenu(AWnd: HWND; AIFolder: IShellFolder;
  AItemPIDLList: TList; const APos: TPoint);
var
  ACallbackWnd: TcxContextMenuMessageWindow;
  ACmd: Longbool;
  AContextMenu: IContextMenu;
  AContextMenu2: IContextMenu2;
  AInvokeCommandInfo: TCMInvokeCommandInfo;
  AMenu: HMENU;
  APIDLList: PItemIDList;
begin
  if (AIFolder = nil) or (AItemPIDLList.Count = 0) then
    Exit;
  APIDLList := CreatePidlListFromList(AItemPIDLList);
  try
    if Failed(AIFolder.GetUIObjectOf(AWnd, AItemPIDLList.Count,
      PItemIDList(APIDLList^), IID_IContextMenu, nil, AContextMenu)) then
        Exit;
    AMenu := CreatePopupMenu;
    ACallbackWnd := nil;    
    if AMenu <> 0 then
    try
      if Failed(AContextMenu.QueryContextMenu(AMenu, 0, 1, $7FFF, CMF_NORMAL)) then
        Exit;
      if Succeeded(AContextMenu.QueryInterface(IID_IContextMenu2, AContextMenu2)) then
        ACallbackWnd := CreateCallbackWnd(AContextMenu2);
      if ACallbackWnd <> nil then
        ACmd := TrackPopupMenu(AMenu, TPM_LEFTALIGN or TPM_LEFTBUTTON or
          TPM_RIGHTBUTTON or TPM_RETURNCMD, APos.X, APos.Y, 0, ACallbackWnd.Handle, nil)
      else
        ACmd := TrackPopupMenu(AMenu, TPM_LEFTALIGN or TPM_LEFTBUTTON or
          TPM_RIGHTBUTTON or TPM_RETURNCMD, APos.X, APos.Y, 0, AWnd, nil);
      if ACmd then
      begin
        ZeroMemory(@AInvokeCommandInfo, SizeOf(AInvokeCommandInfo));
        AInvokeCommandInfo.cbSize := SizeOf(AInvokeCommandInfo);
        AInvokeCommandInfo.hwnd := AWnd;
        AInvokeCommandInfo.lpVerb := MakeIntResource(Longint(ACmd) - 1);
        AInvokeCommandInfo.nShow := SW_SHOWNORMAL;
        AContextMenu.InvokeCommand(AInvokeCommandInfo);
      end;
    finally
      DestroyMenu(AMenu);
      FreeAndNil(ACallbackWnd);
    end;
  finally
    DisposePidl(APIDLList);
  end;
end;

function SysFileIconIndex: Integer;
var
  AFileInfo: TSHFileInfo;
begin
  if FSysFileIconIndex = -1 then
  begin
    SHGetFileInfo('C:\CXDUMMYFILE.TXT', FILE_ATTRIBUTE_NORMAL, AFileInfo,
      SizeOf(AFileInfo), SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES);
    FSysFileIconIndex := AFileInfo.iIcon;
  end;
  Result := FSysFileIconIndex;
end;

function SysFolderIconIndex: Integer;
var
  AFileInfo: TSHFileInfo;
begin
  if FSysFolderIconIndex = -1 then
  begin
    SHGetFileInfo('C:\CXDUMMYFOLDER', FILE_ATTRIBUTE_DIRECTORY, AFileInfo,
      SizeOf(AFileInfo), SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES);
    FSysFolderIconIndex := AFileInfo.iIcon;
  end;
  Result := FSysFolderIconIndex;
end;

function SysFolderOpenIconIndex: Integer;
var
  AFileInfo: TSHFileInfo;
begin
  if FSysFolderOpenIconIndex = -1 then
  begin
    SHGetFileInfo('C:\CXDUMMYFOLDER', FILE_ATTRIBUTE_DIRECTORY, AFileInfo,
      SizeOf(AFileInfo), SHGFI_SYSICONINDEX or SHGFI_USEFILEATTRIBUTES or SHGFI_OPENICON);
    FSysFolderOpenIconIndex := AFileInfo.iIcon;
  end;
  Result := FSysFolderOpenIconIndex;
end;

{ Unicode Tools }

function UpperCaseW(Source:WideString):WideString;
begin
  Result:=AnsiUpperCase(Source);
end;

function LowerCaseW(Source:WideString):WideString;
begin
  Result:=AnsiLowerCase(Source);
end;

function StrLenW(Source: PWideChar): Cardinal;
asm
  MOV     EDX, EDI
  MOV     EDI, EAX
  MOV     ECX, 0FFFFFFFFH
  XOR     AX, AX
  REPNE   SCASW
  MOV     EAX, 0FFFFFFFEH
  SUB     EAX, ECX
  MOV     EDI, EDX
end;

function StrPasW(Source:PWideChar):WideString;
var
  StringLength:Cardinal;
begin
  StringLength:=StrLenW(Source);
  SetLength(Result,StringLength);
  CopyMemory(Pointer(Result),Source,StringLength*2);
end;

procedure StrPLCopyW(Dest:PWideChar;Source:WideString;MaxLen:Cardinal);
begin 
  lstrcpynw(Dest,PWideChar(Source),MaxLen);
end;

{ PidlTools}

function GetPidlParent(pidl:PItemIDList):PItemIDList;
var
  SourceSize:Integer;
  PrevPidl:PItemIDList;
  InitialPidl:PItemIDList;
  TempPidl:PItemIDList;
begin
  Result:=nil;
  SourceSize:=0;
  InitialPidl:=pidl;
  PrevPidl:=nil;
  if pidl<>nil then
  begin
    while pidl.mkid.cb<>0 do
    begin
      Inc(SourceSize,pidl.mkid.cb);
      PrevPidl:=pidl;
      pidl:=GetNextItemID(pidl);
    end;
    if SourceSize>0 then
       Dec(SourceSize,PrevPidl.mkid.cb);
    Result:=cxMalloc.Alloc(SourceSize+SizeOf(SHITEMID));
    CopyMemory(Result,InitialPidl,SourceSize);
    TempPidl:=Pointer(Integer(Result)+SourceSize);
    TempPidl.mkid.cb:=0;
    TempPidl.mkid.abID[0]:=0;
  end;
end;

function CreateEmptyPidl:PItemIDList;
begin
  Result:=cxMalloc.Alloc(SizeOf(ITEMIDLIST));
  Result.mkid.cb:=0;
  Result.mkid.abID[0]:=0;
end;

function CreatePidlListFromList(List:TList):PItemIDList;
var
  i:Integer;
  tempResult:PITEMIDLISTARRAY;
begin
  Result:=nil;
  if List=nil then
     Exit;
  tempResult:=cxMalloc.Alloc(List.Count*SizeOf(ITEMIDLIST));
  for i:=0 to List.Count-1 do
      tempResult[i]:=List[i];
  Result:=Pointer(tempResult);
end;

function ExtractParticularPidl(pidl:PItemIDList):PItemIDList;
var
  temp:PItemIDList;
begin
  Result:=nil;
  if (pidl<>nil) and (pidl.mkid.cb<>0) then
  begin
    Result:=cxMalloc.Alloc(pidl.mkid.cb+SizeOf(SHITEMID));
    CopyMemory(Result,pidl,pidl.mkid.cb+SizeOf(SHITEMID));
  end;
  temp:=GetNextItemID(Result);
  temp.mkid.cb:=0;
  temp.mkid.abID[0]:=0;
end;

function EqualPIDLs(APIDL1, APIDL2: PItemIDList): Boolean;
var
  L1, L2: Integer;
begin
  Result := APIDL1 = APIDL2;
  if not Result then
    if (APIDL1 = nil) or (APIDL2 = nil) then
      Exit
    else
    begin
      L1 := GetPidlSize(APIDL1);
      L2 := GetPidlSize(APIDL2);
      Result := (L1 = L2) and CompareMem(APIDL1, APIDL2, L1);
    end;
end;

function IsSubPath(APIDL1, APIDL2: PItemIDList): Boolean; // TODO
var
  L1, L2: Integer;
begin
  L1 := GetPidlSize(APIDL1);
  L2 := GetPidlSize(APIDL2);
  Result := (L1 = 0) or (L2 >= L1) and CompareMem(APIDL1, APIDL2, L1);
end;

function ConcatenatePidls(pidl1,pidl2:PItemIDList):PItemIDList;
var
  cb1,cb2:Integer;
begin
  if (pidl1=nil) and (pidl2=nil) then
      Result:=nil
  else
  if pidl1=nil then
     Result:=GetPidlCopy(pidl2)
  else
  if pidl2=nil then
     Result:=GetPidlCopy(pidl1)
  else
  begin
    cb1:=GetPidlSize(pidl1);
    cb2:=GetPidlSize(pidl2)+SizeOf(SHITEMID);
    Result:=cxMalloc.Alloc(cb1+cb2);
    if Result<>nil then
    begin
      CopyMemory(Result,pidl1,cb1);
      CopyMemory(Pointer(Integer(Result)+cb1),pidl2,cb2);
    end;
  end;
end;

function GetPidlName(APIDL: PItemIDList): WideString;
var
  P: PChar;
  PW: PWideChar;
begin
  Result := '';
  if APIDL = nil then
    Exit;
  if not Assigned(cxSHGetPathFromIDListW) then
  begin
    GetMem(P, MAX_PATH + 1);
    try
      cxSHGetPathFromIDList(APIDL, P);
      Result := StrPas(P);
    finally
      FreeMem(P);
    end;
  end
  else
  begin
    GetMem(PW, (MAX_PATH + 1) * 2);
    try
      cxSHGetPathFromIDListW(APIDL, PW);
      Result := StrPasW(PW);
    finally
      FreeMem(PW);
    end;
  end;
end;

function GetLastPidlItem(pidl:PItemIDList):PItemIDList;
var
  TempPidl:PItemIDList;
begin
  Result:=pidl;
  if pidl<>nil then
  begin
    TempPidl:=pidl;
    while TempPidl.mkid.cb<>0 do
    begin
      Result:=TempPidl;
      TempPidl:=GetNextItemID(TempPidl);
    end;
  end;
end;

procedure DisposePidl(pidl:PItemIDList);
begin
  if pidl<>nil then
     cxMalloc.Free(pidl);
end;

function GetPidlCopy(pidl:PItemIDList):PItemIDList;
var
  Size:Integer;
begin
  Result:=nil;
  if pidl<>nil then
  begin
    Size:=GetPidlSize(pidl)+SizeOf(SHITEMID);
    Result:=cxMalloc.Alloc(Size);
    CopyMemory(Result,pidl,Size);
  end;
end;

function GetPidlItemsCount(pidl:PItemIDList):Integer;
begin
  Result:=0;
  if pidl<>nil then
  begin
    while pidl.mkid.cb<>0 do
    begin
      Inc(Result);
      pidl:=GetNextItemID(pidl);
      if Result>MAX_PATH then
      begin
        Result:=-1;
        Break;
      end;
    end;
  end;
end;

function GetPidlSize(pidl:PItemIDList):Integer;
begin
  Result:=0;
  while (pidl<>nil) and (pidl.mkid.cb<>0) do
  begin
    Inc(Result,pidl.mkid.cb);
    pidl:=GetNextItemID(pidl);
  end;
end;

function GetNextItemID(pidl:PItemIDList):PItemIDList;
begin
  Result:=nil;
  if (pidl<>nil) and (pidl.mkid.cb<>0) then
     Result:=PItemIDLIst(Integer(pidl)+pidl.mkid.cb);
end;

function cxShellItemsInfoGathererFetchThreadFunction(
  AItemsInfoGatherer: TcxShellItemsInfoGatherer): Integer; stdcall;

  function CanProcessFetchQueueItems: Boolean;
  begin
    Result := not AItemsInfoGatherer.IsFetchThreadTerminating and
      not AItemsInfoGatherer.IsFetchStopping;
  end;

  procedure ProcessFetchQueueItem(AItem: PcxRequestItem);
  var
    AItemData: TcxShellItemInfo;
    AItemProducer: TcxCustomItemProducer;
  begin
    AItemProducer := AItem^.ItemProducer;
    AItemProducer.LockRead;
    try
      if AItem^.ItemIndex >= AItemProducer.Items.Count then
        Exit;
      AItemData := AItemProducer.Items[AItem^.ItemIndex];
      AItemData.CheckUpdate(AItemProducer.ShellFolder,
        AItemProducer.FolderPidl, False);
      AItemProducer.CheckForSubItems(AItemData);
      AItemData.Updated := True;
    finally
      AItem^.ItemProducer.UnlockRead;
    end;
    AItemProducer.NotifyUpdateItem(AItem);
  end;

  procedure ProcessFetchQueueItems;
  var
    AFetchQueue: TList;
  begin
    AFetchQueue := AItemsInfoGatherer.FetchQueue;
    while AFetchQueue.Count <> 0 do
    begin
      ProcessFetchQueueItem(PcxRequestItem(AFetchQueue[0]));
      Dispose(AFetchQueue[0]);
      AFetchQueue.Delete(0);
      if not CanProcessFetchQueueItems then
        Break;
    end;
  end;

const
  cxShellItemsInfoGathererSleepPause = 10;
begin
  CoInitializeEx(nil, COINIT_APARTMENTTHREADED);
  try