Author: Peter Below
Clipboard access routines which use only API functions
Answer:
Solve 1:
This unit provides clipboard access routines that do not rely on the VCL Clipbrd
unit. That unit drags in Dialogs and Forms and a major part of the VCL as a
consequence, not appropriate for simple console or non-form programs. This unit
uses only API routines, the only VCL units used are Classes (for exceptions and
streams) and SysUtils.
1 {Clipboard access routines using only API functions
2 Author: Dr. Peter Below
3 Version 1.0 created 5 Juli 2000
4 Current revision 1.0
5 Last modified: 5 Juli 2000}
6
7 unit APIClipboard;
8
9 interface
10
11 uses
12 Windows, Classes;
13
14 procedure StringToClipboard(const S: string);
15 function ClipboardAsString: string;
16 procedure CopyDataToClipboard(fmt: DWORD; const data; datasize: Integer;
17 emptyClipboardFirst: Boolean = true);
18 procedure CopyDataFromClipboard(fmt: DWORD; S: TStream);
19 function ClipboardHasFormat(fmt: DWORD): Boolean;
20
21 implementation
22
23 uses
24 Sysutils;
25
26 type
27 {This is an internal exception class used by the unit=APIClipboard }
28 EclipboardError = class(Exception)
29 public
30 constructor Create(const msg: string);
31 end;
32
33 resourcestring
34 eSystemOutOfMemory = 'could not allocate memory for clipboard data.';
35 eLockfailed = 'could not lock global memory handle.';
36 eSetDataFailed = 'could not copy data block to clipboard.';
37 eCannotOpenClipboard = 'could not open the clipboard.';
38 eErrorTemplate = 'APIClipboard: %s'#13#10 + 'System error code: %d'#13#10
39 + 'System error message: %s';
40
41 {EClipboardError.Create - Creates a new EclipboardError object
42
43 Param msg is the string to embed into the error message
44 Precondition: none
45 Postcondition: none
46
47 Description:
48 Composes an error message that contains the passed message and the API error code
49 and matching error message. The CreateFmt constructor inherited from the basic
50 Exception class is used to do the work.
51
52 Created 5.7.2000 by P. Below}
53
54 constructor EClipboardError.Create(const msg: string);
55 begin
56 CreateFmt(eErrorTemplate, [msg, GetLastError, SysErrorMessage(GetLastError)]);
57 end;
58
59 {DataToClipboard - Copies a block of memory to the clipboard in a given format
60
61 Param fmt is the clipboard format to use
62 Param data is an untyped const parameter that addresses the data to copy
63 Param datasize is the size of the data, in bytes
64
65 Precondition:
66 The clipboard is already open. If not an EClipboardError will result. This
67 precondition cannot be asserted, unfortunately.
68
69 Postcondition:
70 Any previously exisiting data of this format will have been replaced by the new
71 data, unless datasize was 0 or we run into an exception. In this case the clipboard
72 will be unchanged.
73
74 Description:
75 Uses API methods to allocate and lock a global memory block of approproate size,
76 copies the data to it and submits the block to the clipboard. Any error on the way
77 will raise an EClipboardError exception.
78
79 Created 5.7.2000 by P. Below}
80
81 procedure DataToClipboard(fmt: DWORD; const data; datasize: Integer);
82 var
83 hMem: THandle;
84 pMem: Pointer;
85 begin
86 if datasize <= 0 then
87 Exit;
88 hMem := GlobalAlloc(GMEM_MOVEABLE or GMEM_SHARE or GMEM_ZEROINIT, datasize);
89 if hmem = 0 then
90 raise EclipboardError.Create(eSystemOutOfMemory);
91 pMem := GlobalLock(hMem);
92 if pMem = nil then
93 begin
94 GlobalFree(hMem);
95 raise EclipboardError.Create(eLockFailed);
96 end;
97 Move(data, pMem^, datasize);
98 GlobalUnlock(hMem);
99 if SetClipboardData(fmt, hMem) = 0 then
100 raise EClipboarderror(eSetDataFailed);
101 {Note: API docs are unclear as to whether the memory block has to be freed in
102 case of failure. Since failure is unlikely here lets blithly ignore this issue
103 for now.}
104 end;
105
106 {DataFromClipboard - Copies data from the clipboard into a stream
107
108 Param fmt is the clipboard format to look for
109 Param S is the stream to copy to
110 precondition: S <> nil
111 postcondition: If data was copied the streams position will have moved
112
113 Description:
114 Tries to get a memory block for the requested clipboard format. Nothing further is
115 done if this fails (because the format is not available or the clipboard is not
116 open, we treat neither as error here), otherwise the memory handle is locked and
117 the data copied into the stream. Note that we cannot determine the actual size of
118 the data originally copied to the clipboard, only the allocated size of the memory
119 block! Since GlobalAlloc works with a granularity of 32 bytes the block may be
120 larger than required for the data and thus the stream may contain some spurious
121 bytes at the end. There is no guarantee that these bytes will be 0. If the memory
122 handle obtained from the clipboard cannot be locked we raise an (see
123 class=EClipboardError) exception.
124
125 Created 5.7.2000 by P. Below}
126
127 procedure DataFromClipboard(fmt: DWORD; S: TStream);
128 var
129 hMem: THandle;
130 pMem: Pointer;
131 datasize: DWORD;
132 begin
133 Assert(Assigned(S));
134 hMem := GetClipboardData(fmt);
135 if hMem <> 0 then
136 begin
137 datasize := GlobalSize(hMem);
138 if datasize > 0 then
139 begin
140 pMem := GlobalLock(hMem);
141 if pMem = nil then
142 raise EclipboardError.Create(eLockFailed);
143 try
144 S.WriteBuffer(pMem^, datasize);
145 finally
146 GlobalUnlock(hMem);
147 end;
148 end;
149 end;
150 end;
151
152 {CopyDataToClipboard - Copies a block of memory to the clipboard in a given format
153
154 Param fmt is the clipboard format to use Param data is an untyped const parameter
155 that addresses the data to copy Param datasize is the size of the data, in bytes
156 Param emptyClipboardFirst determines if the clipboard should be emptied, true by
157 default
158
159 Precondition:
160 The clipboard must not be open already
161
162 Postcondition:
163 If emptyClipboardFirst is true all prior data will be cleared from the clipboard,
164 even if
165 datasize is <= 0. The clipboard is closed again.
166
167 Description:
168 Tries to open the clipboard, empties it if required and then tries to copy the
169 passed data to the clipboard. This operation is a NOP if datasize <= 0. If the
170 clipboard cannot be opened a (see class=EClipboardError) is raised.
171
172 Created 5.7.2000 by P. Below}
173
174 procedure CopyDataToClipboard(fmt: DWORD; const data; datasize: Integer;
175 emptyClipboardFirst: Boolean = true);
176 begin
177 if OpenClipboard(0) then
178 try
179 if emptyClipboardFirst then
180 EmptyClipboard;
181 DataToClipboard(fmt, data, datasize);
182 finally
183 CloseClipboard;
184 end
185 else
186 raise EclipboardError.Create(eCannotOpenClipboard);
187 end;
188
189 {StringToClipboard - Copies a string to clipboard in CF_TEXT clipboard format
190
191 Param S is the string to copy, it may be empty.
192
193 Precondition:
194 The clipboard must not be open already.
195
196 Postcondition:
197 Any prior clipboard content will be cleared, but only if S was not empty. The
198 clipboard is closed again.
199
200 Description:
201 Hands the brunt of the work off to (See routine=CopyDataToClipboard), but only if S
202 was not empty. Otherwise nothing is done at all.
203
204 Created 5.7.2000 by P. Below}
205
206 procedure StringToClipboard(const S: string);
207 begin
208 if Length(S) > 0 then
209 CopyDataToClipboard(CF_TEXT, S[1], Length(S) + 1);
210 end;
211
212 {CopyDataFromClipboard - Copies data from the clipboard into a stream
213
214 Param fmt is the clipboard format to look for
215 Param S is the stream to copy to
216
217 Precondition:
218 S <> nil
219 The clipboard must not be open already.
220
221 Postcondition:
222 If data was copied the streams position will have moved. The clipboard is closed
223 again.
224
225 Description:
226 Tries to open the clipboard, and then tries to copy the data to the passed stream.
227 This operation is a NOP if the clipboard does not contain data in the requested
228 format. If the clipboard cannot be opened a (see class=EClipboardError) is raised.
229
230 Created 5.7.2000 by P. Below}
231
232 procedure CopyDataFromClipboard(fmt: DWORD; S: TStream);
233 begin
234 Assert(Assigned(S));
235 if OpenClipboard(0) then
236 try
237 DataFromClipboard(fmt, S);
238 finally
239 CloseClipboard;
240 end
241 else
242 raise EclipboardError.Create(eCannotOpenClipboard);
243 end;
244
245 {ClipboardAsString - Returns any text contained on the clipboard. Returns the
246 clipboards content if it contained something in CF_TEXT format, or an empty string.
247
248 Precondition: The clipboard must not be already open
249 Postcondition: The clipboard is closed.
250
251 Description:
252 If the clipboard contains data in CF_TEXT format it is copied to a temp memory
253 stream,
254 zero-terminated for good measure and copied into the result string.
255
256 Created 5.7.2000 by P. Below}
257
258 function ClipboardAsString: string;
259 const
260 nullchar: Char = #0;
261 var
262 ms: TMemoryStream;
263 begin
264 if not IsClipboardFormatAvailable(CF_TEXT) then
265 Result := EmptyStr
266 else
267 begin
268 ms := TMemoryStream.Create;
269 try
270 CopyDataFromClipboard(CF_TEXT, ms);
271 ms.Seek(0, soFromEnd);
272 ms.WriteBuffer(nullChar, Sizeof(nullchar));
273 Result := Pchar(ms.Memory);
274 finally
275 ms.Free;
276 end;
277 end;
278 end;
279
280 {ClipboardHasFormat - Checks if the clipboard contains data in the specified format
281
282 Param fmt is the format to check for. Returns true if the clipboard contains data
283 in this format, false otherwise
284
285 Precondition: none
286 Postcondition: none
287
288 Description:
289 This is a simple wrapper around an API function.
290
291 Created 5.7.2000 by P. Below}
292
293 function ClipboardHasFormat(fmt: DWORD): Boolean;
294 begin
295 Result := IsClipboardFormatAvailable(fmt);
296 end;
297
298 end.
Solve 2:
299 uses
300 Windows, SysUtils;
301
302 procedure SetClipboardText(const S: string);
303 var
304 H: THandle;
305 begin
306 if not OpenClipboard(0) then
307 RaiseLastWin32Error;
308 try
309 if not EmptyClipboard then
310 RaiseLastWin32Error;
311 H := GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE, Length(S) + 1);
312 if H = 0 then
313 RaiseLastWin32Error;
314 StrPCopy(GlobalLock(H), S);
315 GlobalUnlock(H);
316 SetClipboardData(CF_TEXT, H);
317 finally
318 CloseClipboard;
319 end;
320 end;
|
