1 {==============================================================================|
2 | Project : Ararat Synapse | 001.001.002 |
3 |==============================================================================|
4 | Content: ICONV support for Win32, OS/2, Linux and .NET |
5 |==============================================================================|
6 | Copyright (c)2004-2013, Lukas Gebauer |
7 | All rights reserved. |
8 | |
9 | Redistribution and use in source and binary forms, with or without |
10 | modification, are permitted provided that the following conditions are met: |
11 | |
12 | Redistributions of source code must retain the above copyright notice, this |
13 | list of conditions and the following disclaimer. |
14 | |
15 | Redistributions in binary form must reproduce the above copyright notice, |
16 | this list of conditions and the following disclaimer in the documentation |
17 | and/or other materials provided with the distribution. |
18 | |
19 | Neither the name of Lukas Gebauer nor the names of its contributors may |
20 | be used to endorse or promote products derived from this software without |
21 | specific prior written permission. |
22 | |
23 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" |
24 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE |
25 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE |
26 | ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR |
27 | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL |
28 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR |
29 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER |
30 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT |
31 | LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY |
32 | OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
33 | DAMAGE. |
34 |==============================================================================|
35 | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
36 | Portions created by Lukas Gebauer are Copyright (c)2004-2013. |
37 | All Rights Reserved. |
38 |==============================================================================|
39 | Contributor(s): |
40 | Tomas Hajny (OS2 support) |
41 |==============================================================================|
42 | History: see HISTORY.HTM from distribution package |
43 | (Found at URL: http://www.ararat.cz/synapse/) |
44 |==============================================================================}
45
46 {$IFDEF FPC}
47 {$MODE DELPHI}
48 {$ENDIF}
49 {$H+}
50 //old Delphi does not have MSWINDOWS define.
51 {$IFDEF WIN32}
52 {$IFNDEF MSWINDOWS}
53 {$DEFINE MSWINDOWS}
54 {$ENDIF}
55 {$ENDIF}
56
57 {:@abstract(LibIconv support)
58
59 This unit is Pascal interface to LibIconv library for charset translations.
60 LibIconv is loaded dynamicly on-demand. If this library is not found in system,
61 requested LibIconv function just return errorcode.
62 }
63 unit synaicnv;
64
65 interface
66
67 uses
68 {$IFDEF CIL}
69 System.Runtime.InteropServices,
70 System.Text,
71 {$ENDIF}
72 synafpc,
73 {$IFNDEF MSWINDOWS}
74 {$IFNDEF FPC}
75 Libc,
76 {$ENDIF}
77 SysUtils;
78 {$ELSE}
79 Windows;
80 {$ENDIF}
81
82
83 const
84 {$IFNDEF MSWINDOWS}
85 {$IFDEF OS2}
86 DLLIconvName = 'iconv.dll';
87 {$ELSE OS2}
88 DLLIconvName = 'libiconv.so';
89 {$ENDIF OS2}
90 {$ELSE}
91 DLLIconvName = 'iconv.dll';
92 {$ENDIF}
93
94 type
95 size_t = Cardinal;
96 {$IFDEF CIL}
97 iconv_t = IntPtr;
98 {$ELSE}
99 iconv_t = Pointer;
100 {$ENDIF}
101 argptr = iconv_t;
102
103 var
104 iconvLibHandle: TLibHandle = 0;
105
SynaIconvOpennull106 function SynaIconvOpen(const tocode, fromcode: Ansistring): iconv_t;
SynaIconvOpenTranslitnull107 function SynaIconvOpenTranslit(const tocode, fromcode: Ansistring): iconv_t;
SynaIconvOpenIgnorenull108 function SynaIconvOpenIgnore(const tocode, fromcode: Ansistring): iconv_t;
SynaIconvnull109 function SynaIconv(cd: iconv_t; inbuf: AnsiString; var outbuf: AnsiString): integer;
SynaIconvClosenull110 function SynaIconvClose(var cd: iconv_t): integer;
SynaIconvCtlnull111 function SynaIconvCtl(cd: iconv_t; request: integer; argument: argptr): integer;
112
IsIconvloadednull113 function IsIconvloaded: Boolean;
InitIconvInterfacenull114 function InitIconvInterface: Boolean;
DestroyIconvInterfacenull115 function DestroyIconvInterface: Boolean;
116
117 const
118 ICONV_TRIVIALP = 0; // int *argument
119 ICONV_GET_TRANSLITERATE = 1; // int *argument
120 ICONV_SET_TRANSLITERATE = 2; // const int *argument
121 ICONV_GET_DISCARD_ILSEQ = 3; // int *argument
122 ICONV_SET_DISCARD_ILSEQ = 4; // const int *argument
123
124
125 implementation
126
127 uses SyncObjs;
128
129 {$IFDEF CIL}
130 [DllImport(DLLIconvName, CharSet = CharSet.Ansi,
131 SetLastError = False, CallingConvention= CallingConvention.cdecl,
132 EntryPoint = 'libiconv_open')]
_iconv_opennull133 function _iconv_open(tocode: string; fromcode: string): iconv_t; external;
134
135 [DllImport(DLLIconvName, CharSet = CharSet.Ansi,
136 SetLastError = False, CallingConvention= CallingConvention.cdecl,
137 EntryPoint = 'libiconv')]
_iconvnull138 function _iconv(cd: iconv_t; var inbuf: IntPtr; var inbytesleft: size_t;
139 var outbuf: IntPtr; var outbytesleft: size_t): size_t; external;
140
141 [DllImport(DLLIconvName, CharSet = CharSet.Ansi,
142 SetLastError = False, CallingConvention= CallingConvention.cdecl,
143 EntryPoint = 'libiconv_close')]
_iconv_closenull144 function _iconv_close(cd: iconv_t): integer; external;
145
146 [DllImport(DLLIconvName, CharSet = CharSet.Ansi,
147 SetLastError = False, CallingConvention= CallingConvention.cdecl,
148 EntryPoint = 'libiconvctl')]
_iconvctlnull149 function _iconvctl(cd: iconv_t; request: integer; argument: argptr): integer; external;
150
151 {$ELSE}
152 type
ocodenull153 Ticonv_open = function(tocode: pAnsichar; fromcode: pAnsichar): iconv_t; cdecl;
dnull154 Ticonv = function(cd: iconv_t; var inbuf: pointer; var inbytesleft: size_t;
155 var outbuf: pointer; var outbytesleft: size_t): size_t; cdecl;
dnull156 Ticonv_close = function(cd: iconv_t): integer; cdecl;
dnull157 Ticonvctl = function(cd: iconv_t; request: integer; argument: argptr): integer; cdecl;
158 var
159 _iconv_open: Ticonv_open = nil;
160 _iconv: Ticonv = nil;
161 _iconv_close: Ticonv_close = nil;
162 _iconvctl: Ticonvctl = nil;
163 {$ENDIF}
164
165
166 var
167 IconvCS: TCriticalSection;
168 Iconvloaded: boolean = false;
169
SynaIconvOpennull170 function SynaIconvOpen (const tocode, fromcode: Ansistring): iconv_t;
171 begin
172 {$IFDEF CIL}
173 try
174 Result := _iconv_open(tocode, fromcode);
175 except
176 on Exception do
177 Result := iconv_t(-1);
178 end;
179 {$ELSE}
180 if InitIconvInterface and Assigned(_iconv_open) then
181 Result := _iconv_open(PAnsiChar(tocode), PAnsiChar(fromcode))
182 else
183 Result := iconv_t(-1);
184 {$ENDIF}
185 end;
186
SynaIconvOpenTranslitnull187 function SynaIconvOpenTranslit (const tocode, fromcode: Ansistring): iconv_t;
188 begin
189 Result := SynaIconvOpen(tocode + '//IGNORE//TRANSLIT', fromcode);
190 end;
191
SynaIconvOpenIgnorenull192 function SynaIconvOpenIgnore (const tocode, fromcode: Ansistring): iconv_t;
193 begin
194 Result := SynaIconvOpen(tocode + '//IGNORE', fromcode);
195 end;
196
SynaIconvnull197 function SynaIconv (cd: iconv_t; inbuf: AnsiString; var outbuf: AnsiString): integer;
198 var
199 {$IFDEF CIL}
200 ib, ob: IntPtr;
201 ibsave, obsave: IntPtr;
202 l: integer;
203 {$ELSE}
204 ib, ob: Pointer;
205 {$ENDIF}
206 ix, ox: size_t;
207 begin
208 {$IFDEF CIL}
209 l := Length(inbuf) * 4;
210 ibsave := IntPtr.Zero;
211 obsave := IntPtr.Zero;
212 try
213 ibsave := Marshal.StringToHGlobalAnsi(inbuf);
214 obsave := Marshal.AllocHGlobal(l);
215 ib := ibsave;
216 ob := obsave;
217 ix := Length(inbuf);
218 ox := l;
219 _iconv(cd, ib, ix, ob, ox);
220 Outbuf := Marshal.PtrToStringAnsi(obsave, l);
221 setlength(Outbuf, l - ox);
222 Result := Length(inbuf) - ix;
223 finally
224 Marshal.FreeCoTaskMem(ibsave);
225 Marshal.FreeHGlobal(obsave);
226 end;
227 {$ELSE}
228 if InitIconvInterface and Assigned(_iconv) then
229 begin
230 setlength(Outbuf, Length(inbuf) * 4);
231 ib := Pointer(inbuf);
232 ob := Pointer(Outbuf);
233 ix := Length(inbuf);
234 ox := Length(Outbuf);
235 _iconv(cd, ib, ix, ob, ox);
236 setlength(Outbuf, cardinal(Length(Outbuf)) - ox);
237 Result := Cardinal(Length(inbuf)) - ix;
238 end
239 else
240 begin
241 Outbuf := '';
242 Result := 0;
243 end;
244 {$ENDIF}
245 end;
246
SynaIconvClosenull247 function SynaIconvClose(var cd: iconv_t): integer;
248 begin
249 if cd = iconv_t(-1) then
250 begin
251 Result := 0;
252 Exit;
253 end;
254 {$IFDEF CIL}
255 try;
256 Result := _iconv_close(cd)
257 except
258 on Exception do
259 Result := -1;
260 end;
261 cd := iconv_t(-1);
262 {$ELSE}
263 if InitIconvInterface and Assigned(_iconv_close) then
264 Result := _iconv_close(cd)
265 else
266 Result := -1;
267 cd := iconv_t(-1);
268 {$ENDIF}
269 end;
270
SynaIconvCtlnull271 function SynaIconvCtl (cd: iconv_t; request: integer; argument: argptr): integer;
272 begin
273 {$IFDEF CIL}
274 Result := _iconvctl(cd, request, argument)
275 {$ELSE}
276 if InitIconvInterface and Assigned(_iconvctl) then
277 Result := _iconvctl(cd, request, argument)
278 else
279 Result := 0;
280 {$ENDIF}
281 end;
282
InitIconvInterfacenull283 function InitIconvInterface: Boolean;
284 begin
285 IconvCS.Enter;
286 try
287 if not IsIconvloaded then
288 begin
289 {$IFDEF CIL}
290 IconvLibHandle := 1;
291 {$ELSE}
292 IconvLibHandle := LoadLibrary(PChar(DLLIconvName));
293 {$ENDIF}
294 if (IconvLibHandle <> 0) then
295 begin
296 {$IFNDEF CIL}
297 _iconv_open := GetProcAddress(IconvLibHandle, PAnsiChar(AnsiString('libiconv_open')));
298 _iconv := GetProcAddress(IconvLibHandle, PAnsiChar(AnsiString('libiconv')));
299 _iconv_close := GetProcAddress(IconvLibHandle, PAnsiChar(AnsiString('libiconv_close')));
300 _iconvctl := GetProcAddress(IconvLibHandle, PAnsiChar(AnsiString('libiconvctl')));
301 {$ENDIF}
302 Result := True;
303 Iconvloaded := True;
304 end
305 else
306 begin
307 //load failed!
308 if IconvLibHandle <> 0 then
309 begin
310 {$IFNDEF CIL}
311 FreeLibrary(IconvLibHandle);
312 {$ENDIF}
313 IconvLibHandle := 0;
314 end;
315 Result := False;
316 end;
317 end
318 else
319 //loaded before...
320 Result := true;
321 finally
322 IconvCS.Leave;
323 end;
324 end;
325
DestroyIconvInterfacenull326 function DestroyIconvInterface: Boolean;
327 begin
328 IconvCS.Enter;
329 try
330 Iconvloaded := false;
331 if IconvLibHandle <> 0 then
332 begin
333 {$IFNDEF CIL}
334 FreeLibrary(IconvLibHandle);
335 {$ENDIF}
336 IconvLibHandle := 0;
337 end;
338 {$IFNDEF CIL}
339 _iconv_open := nil;
340 _iconv := nil;
341 _iconv_close := nil;
342 _iconvctl := nil;
343 {$ENDIF}
344 finally
345 IconvCS.Leave;
346 end;
347 Result := True;
348 end;
349
IsIconvloadednull350 function IsIconvloaded: Boolean;
351 begin
352 Result := IconvLoaded;
353 end;
354
355 initialization
356 begin
357 IconvCS:= TCriticalSection.Create;
358 end;
359
360 finalization
361 begin
362 {$IFNDEF CIL}
363 DestroyIconvInterface;
364 {$ENDIF}
365 IconvCS.Free;
366 end;
367
368 end.
369