dfsrc.pas

这一系列是我平时收集的pascal深入核心编程

unit DFSrc;

interface

uses Windows, ShlObj, ShellAPI, CommDlg;

 // 取第nIndex个字符串(文件名)
function MultiStrUtil_FindStr(szStrAll: PChar; nIndex: Integer; pnMax: PInteger): PChar; stdcall;

 // 是否选择了多个文件
function FileOpenUtil_AreMultipleFilesSelected(pofn: POpenFilename): BOOL; stdcall;

 // 文件列表内含文件个数
function FileOpenUtil_GetNumFiles(pofn: POpenFilename): Integer; stdcall;

 // 取第nIndex个文件完整路径
function FileOpenUtil_GetFile(pofn: POpenFilename; nIndex: Integer; szPathname: PChar): Integer; stdcall;

 // 目标或其父窗口是否接受文件拖放
function DFSrc_OkToDrop(ppt: PPOINT): HWND; stdcall;

 // 分配头部结构内存块
function DFSrc_Create(ppt: PPOINT; fNC, fWide: BOOL): HDROP; stdcall;

 // 向结构尾部追加文件
function DFSrc_AppendPathname(hdrop: HDROP; pvPathname: Pointer): HDROP; stdcall;
 
implementation

 // (单个)目标窗口是否接受文件拖放
function IsAcceptingFiles(hWnd: HWND): Boolean;
begin
  Result := (GetWindowLong(hWnd, GWL_EXSTYLE) and WS_EX_ACCEPTFILES) <> 0;
end;

 // 目标或其父窗口是否接受文件拖放
function DFSrc_OkToDrop(ppt: PPoint): HWND; stdcall;
var
  ptMousePos: TPoint;
begin
  if (ppt = nil) then
  begin
    ptMousePos.x := LOWORD(GetMessagePos());
    ptMousePos.y := HIWORD(GetMessagePos());
  end else
    ptMousePos := ppt^; // 这句我自己加的 ^^

 // 取得指定位置所处的窗口
  Result := WindowFromPoint(ptMousePos);

 // 看看目标窗囗或其父窗口是否接受文件拖放
  while IsWindow(Result) and (IsAcceptingFiles(Result) = FALSE) do
    Result := GetParent(Result);

 // 如果接受, 返回其句柄, 否则返回"空"句柄
  if (IsWindow(Result) = FALSE) or (IsAcceptingFiles(Result) = FALSE) then
    Result := 0;
end;

 // 分配头部结构内存
function DFSrc_Create(ppt: PPoint; fNC, fWide: BOOL): HDROP; stdcall;
var
  PtDropFiles: PDropFiles;
begin
 // 分配头部结构
  if fWide then
    Result := GlobalAlloc(GMEM_MOVEABLE or GMEM_ZEROINIT, SizeOf(TDropFiles) + SizeOf(WideChar))
  else
    Result := GlobalAlloc(GMEM_MOVEABLE or GMEM_ZEROINIT, SizeOf(TDropFiles) + SizeOf(Char));

 // 填写结构成员
  if (Result <> 0) then
  begin
    PtDropFiles := PDropFiles(GlobalLock(Result));

    PtDropFiles.pFiles := SizeOf(TDropFiles);
    PtDropFiles.pt := ppt^;
    PtDropFiles.fNC := fNC;
    PtDropFiles.fWide := fWide;

    GlobalUnlock(Result);
  end;
end;

 // 向结构尾部追加文件
function DFSrc_AppendPathname(hDrop: HDROP; pvPathname: Pointer): HDROP; stdcall;
var
  PtDropFiles: PDropFiles;
  szPathA: PChar;
  szPathW: PWideChar;
  nOffsetOfNewPathname, nPathSize: Integer;
begin
  PtDropFiles := PDropFiles(GlobalLock(hdrop));

 // 定位至结构头尾部
  szPathA := PChar(DWORD(PtDropFiles) + PtDropFiles.pFiles);
  szPathW := PWideChar(szPathA);

 // 是Unicode宽字符?
  if (PtDropFiles.fWide) then
  begin
   // 定位尾部
    while (szPathW^ <> #0) do
    begin
      while (szPathW^ <> #0) do Inc(szPathW);
      Inc(szPathW);
    end;

   // 首尾间距
    nOffsetOfNewPathname := Integer(szPathW) - Integer(PtDropFiles);
    
   // 新串长度
    nPathSize := SizeOf(WideChar) * (lstrlenW(pvPathname) + 2);
  end else
  begin
   // 定位尾部
    while (szPathA^ <> #0) do
    begin
      while (szPathA^ <> #0) do Inc(szPathA);
      Inc(szPathA);
    end;

   // 首尾间距
    nOffsetOfNewPathname := Integer(szPathA) - Integer(PtDropFiles);

   // 新串长度
    nPathSize := SizeOf(Char) * (lstrlenA(pvPathname) + 2);
  end;

  GlobalUnlock(hdrop);

 // 重新分配
  hdrop :=
    GlobalReAlloc(hdrop, nPathSize + nOffsetOfNewPathname, GMEM_MOVEABLE or GMEM_ZEROINIT);

 // 分配成功
  if (hdrop <> 0) then
  begin
    PtDropFiles := PDropFiles(GlobalLock(hdrop));
    if (PtDropFiles.fWide) then
      lstrcmpW(PWideChar(Integer(PtDropFiles) + nOffsetOfNewPathname), pvPathname)
    else
      lstrcpyA(PChar(Integer(PtDropFiles) + nOffsetOfNewPathname), pvPathname);
    GlobalUnlock(hdrop);
  end;

 // 返回句柄 
  Result := hdrop;
end;

 // 取第nIndex个字符串(文件名)
function MultiStrUtil_FindStr(szStrAll: PChar; nIndex: Integer; pnMax: PInteger): PChar; stdcall;
    // 定位#0, 单个字符串尾部
  function SearchEnd(const P: PChar): PChar;
  begin
    Result := P;
    while (Result^ <> #0) do Inc(Result);
  end;
var
  nNumStrs: Integer;
  szStrSingle: PChar;
begin
  if (nIndex = -1) then nIndex := MaxInt;

 // 定位第nIndex个字符串
  szStrSingle := szStrAll;
  nNumStrs := 0;  
  while (szStrSingle^ <> #0) and (nNumStrs < nIndex) do
  begin
    szStrSingle := SearchEnd(szStrSingle) + 1;
    Inc(nNumStrs);
  end;

  if (pnMax <> nil) then pnMax^ := nNumStrs;

 // 一直搜索到尾部也未找到
  if (nNumStrs < nIndex) then
    Result := nil
  else
    Result := szStrSingle;
end;

 // 是否选择了多个文件
function FileOpenUtil_AreMultipleFilesSelected(pofn: POpenFilename): BOOL; stdcall;
begin
 // 如果选择多个文件，nFileOffset是到第一个文件名的偏移(肯定超过路径字符串的长度)
  Result := lstrlen(pofn.lpstrFile) < pofn.nFileOffset;
end;

 // 文件列表内含文件个数
function FileOpenUtil_GetNumFiles(pofn: POpenFilename): Integer; stdcall;
begin
  Result := 1;
  if FileOpenUtil_AreMultipleFilesSelected(pofn) then
  begin
   // 最后一个(也即列表长度)
    MultiStrUtil_FindStr(pofn.lpstrFile, -1, @Result);
    Dec(Result);
  end;
end;

 // 取第nIndex个文件完整路径
function FileOpenUtil_GetFile(pofn: POpenFilename; nIndex: Integer; szPathname: PChar): Integer; stdcall;
begin
  lstrcpy(szPathname, MultiStrUtil_FindStr(pofn.lpstrFile, 0, nil));
  if FileOpenUtil_AreMultipleFilesSelected(pofn) then
  begin
    lstrcat(szPathname, '\');
    lstrcat(szPathname, MultiStrUtil_FindStr(pofn.lpstrFile, nIndex + 1, nil));
  end;
  Result := lstrlen(szPathname);
end;

end.