osapiutils

1
unit OSAPIClipboardFile;
2

3
{$mode objfpc}{$H+}
4
 
5
interface
6
 
7
uses Forms, Classes, SysUtils, ShlObj, ClipBrd, Windows, LazUtils;
8

9

10
//Поместить ссылку на файл в буфер обмена для вставки в файловом менеджере
11
function CopyFilesToClipboard(AFileList: TStrings; AMoveFiles: Boolean=False): boolean;
12

13

14
implementation
15

16
{
17
 DROPEFFECT Constants
18
 https://docs.microsoft.com/ru-ru/windows/win32/com/dropeffect-constants
19
 CF_HDROP
20
 https://docs.microsoft.com/en-us/windows/win32/shell/clipboard#cf_hdrop
21

22
 https://habr.com/ru/post/179131/
23
}
24

25

26
function HDropTrueString(Strs: TStrings) : string;
27
{
28
  Функция преобразует TStirngs в спец-строку для Shell
29
  это спец-строка для буфера обмена, где строки разделены знаком #0
30
  и вся спец-строка строка заканчивается #0#0
31
}
32
var
33
  i:Integer;
34
begin
35
  Result := '';
36

37
  for i:=0 to Strs.Count-1 do
38
  begin
39
      //Strs.Strings[i] := StringReplace(Strs.Strings[i], '\', '\\', [rfReplaceAll]);
40
      Result := Result + Strs.Strings[i] + char(0);
41
  end;
42

43
  Result := Result + char(0);
44

45
end;
46

47
//Поместить ссылку на файл в буфер обмена для вставки в файловом менеджере
48
function CopyFilesToClipboard(AFileList: TStrings; AMoveFiles: Boolean=False): boolean;
49
const
50
  CFSTR_PREFERREDDROPEFFECT = 'Preferred DropEffect';
51
  DROPEFFECT_COPY           = 1;
52
  DROPEFFECT_MOVE           = 2;
53
var
54
  DropFiles : PDropFiles;
55
  hGlobal   : THandle;
56
  iLen      : Integer;
57
  f         : Cardinal;
58
  d         : PCardinal;
59
  FileList  : String;
60
begin
61
  Result    :=False;
62
  FileList  :=HDropTrueString(AFileList);
63
  try
64
    clipboard.Clear;
65
    OpenClipboard(Application.MainForm.Handle);
66

67
    iLen    := 2*Length(FileList) * SizeOf(char);
68
    hGlobal := GlobalAlloc(GMEM_SHARE or GMEM_MOVEABLE or GMEM_ZEROINIT, SizeOf(TDropFiles) + iLen);
69
    try
70
        Win32Check(hGlobal <> 0);
71
        DropFiles := GlobalLock(hGlobal);
72
        try
73
          DropFiles^.pFiles := SizeOf(TDropFiles);
74

75
         {$IFDEF UNICODE}
76
          DropFiles^.fWide := true;
77
         {$ENDIF}
78

79
          Move(FileList[1], (PAnsiChar(DropFiles) + SizeOf(TDropFiles))^, iLen);
80
          if SetClipboardData(CF_HDROP, hGlobal)<>0 then
81
             Result := True;
82
        finally
83
          GlobalUnlock(hGlobal);
84
        end;
85
    except
86
      GlobalFree(hGlobal);
87
    end;
88
    if Result and AMoveFiles then
89
    begin
90
        f       := RegisterClipboardFormat(CFSTR_PREFERREDDROPEFFECT);
91
        hGlobal := GlobalAlloc(GMEM_SHARE or GMEM_MOVEABLE or GMEM_ZEROINIT, sizeof(dword));
92
        try
93
            d       := PCardinal(GlobalLock(hGlobal));
94
            try
95
              d^      := DROPEFFECT_MOVE;
96
              if SetClipboardData(f, hGlobal)<>0 then
97
                 Result := True;
98
            finally
99
              GlobalUnlock(hGlobal);
100
            end;
101
        except
102
          GlobalFree(hGlobal);
103
        end;
104
     end;
105
  finally
106
    CloseClipboard;
107
  end;
108
end;
109

110
{
111
//== Paste
112
procedure ClipBoard_DataPaste(const Target: string);
113
{
114
Эта функция вставит из буфера обмена файлы/папки,
115
которые копировали/вырезали(Ctrl+C / Ctrl+X) в буфер в каком-либо фаловом менеджере(Проводник, ТоталКоммандер)
116
 
117
Target - папка в которую будет вставлены данные
118
Clipboard_OperationType - подфункция которая определяет что надо сделать: Копировать или Вырезать
119
}
120
 
121
var
122
  h : THandle;
123
  Sourse, sr : string;
124
 
125
begin
126
  
127
//Если то, что находиться в буфере
128
//НЕ является файлами/папками, которые копированы/вырезаны, то выходим
129
//CF_HDROP - дескриптор который идентифицирует список файлов.
130
//Прикладная программа может извлечь информацию о файлах, передавая дескриптор функции DragQueryFile.
131
if not Clipboard.HasFormat(CF_HDROP) then exit;
132
 
133
  
134
Clipboard.Open;
135
  
136
try
137
  
138
    h := GetClipboardData(CF_HDROP); //Не знаю будет ли работать
139
  
140
    if h <> 0
141
    then
142
    begin
143
  
144
          Sourse := Shell_Str( ClipBoard_GetDataList(h) );
145
  
146
          sr := Copy( Sourse, 0, Pos(#0, Sourse)-1 );  //Path №1
147
          sr := ExtractFilePath(sr);           //Родительская папка Data
148
 
149
 
150
          if IncludeTrailingBackslash(sr) = IncludeTrailingBackslash(Target)
151
 
152
          then//Делаем копию фала: откуда copy туда и paste
153
          begin
154
                case Clipboard_SendType
155
                of
156
                   5: Shell_DataOperations(sourse, target, FO_COPY, FOF_SIMPLEPROGRESS or FOF_RENAMEONCOLLISION );
157
                   2: Shell_DataOperations(sourse, target, FO_MOVE, FOF_SIMPLEPROGRESS );
158
                end;
159
          end
160
 
161
          else
162
          begin
163
                case Clipboard_SendType
164
                of
165
                   5: Shell_DataOperations(sourse, target, FO_COPY, FOF_SIMPLEPROGRESS );
166
                   2: Shell_DataOperations(sourse, target, FO_MOVE, FOF_SIMPLEPROGRESS );
167
                end;
168
          end;
169
 
170
    end;
171
  
172
finally
173
    Clipboard.Close;
174
end;
175
  
176
end;
177
} 
178
{ 
179
//==== List
180
function ClipBoard_GetDataList(h: THandle) : TStrings;
181
{
182
Вы нажали Ctrl+C или Ctrl+X => послали данные в буфер обмена.
183
Так вот эта функция возвращает список файлов/папок, которые посланы в буфер.
184
}
185
 
186
var
187
  FilePath: array [0..MAX_PATH] of Char;
188
  i, FileCount: Integer;
189
  
190
begin
191
  
192
Result := nil;
193
  
194
if h = 0 then exit;
195
  
196
Result := TStringList.Create;
197
  
198
  
199
FileCount := DragQueryFile(h, $FFFFFFFF, nil, 0);
200
  
201
for i := 0 to FileCount - 1
202
do
203
begin
204
      DragQueryFile(h, i, FilePath, SizeOf(FilePath));
205
      Result.Add(FilePath);
206
end;
207
  
208
end;
209
} 
210

211
 
212
end.
213