source: trunk/Packages/synapse/source/lib/synaicnv.pas

Last change on this file was 2, checked in by chronos, 13 years ago
  • Přidáno: Základní kostra projektu.
  • Přidáno: Knihovna synapse.
File size: 11.1 KB
Line 
1{==============================================================================|
2| Project : Ararat Synapse | 001.001.001 |
3|==============================================================================|
4| Content: ICONV support for Win32, Linux and .NET |
5|==============================================================================|
6| Copyright (c)2004-2010, 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-2010. |
37| All Rights Reserved. |
38|==============================================================================|
39| Contributor(s): |
40|==============================================================================|
41| History: see HISTORY.HTM from distribution package |
42| (Found at URL: http://www.ararat.cz/synapse/) |
43|==============================================================================}
44
45{$IFDEF FPC}
46 {$MODE DELPHI}
47{$ENDIF}
48{$H+}
49//old Delphi does not have MSWINDOWS define.
50{$IFDEF WIN32}
51 {$IFNDEF MSWINDOWS}
52 {$DEFINE MSWINDOWS}
53 {$ENDIF}
54{$ENDIF}
55
56{:@abstract(LibIconv support)
57
58This unit is Pascal interface to LibIconv library for charset translations.
59LibIconv is loaded dynamicly on-demand. If this library is not found in system,
60requested LibIconv function just return errorcode.
61}
62unit synaicnv;
63
64interface
65
66uses
67{$IFDEF CIL}
68 System.Runtime.InteropServices,
69 System.Text,
70{$ENDIF}
71 synafpc,
72{$IFNDEF MSWINDOWS}
73 {$IFNDEF FPC}
74 Libc,
75 {$ENDIF}
76 SysUtils;
77{$ELSE}
78 Windows;
79{$ENDIF}
80
81
82const
83 {$IFNDEF MSWINDOWS}
84 DLLIconvName = 'libiconv.so';
85 {$ELSE}
86 DLLIconvName = 'iconv.dll';
87 {$ENDIF}
88
89type
90 size_t = Cardinal;
91{$IFDEF CIL}
92 iconv_t = IntPtr;
93{$ELSE}
94 iconv_t = Pointer;
95{$ENDIF}
96 argptr = iconv_t;
97
98var
99 iconvLibHandle: TLibHandle = 0;
100
101function SynaIconvOpen(const tocode, fromcode: Ansistring): iconv_t;
102function SynaIconvOpenTranslit(const tocode, fromcode: Ansistring): iconv_t;
103function SynaIconvOpenIgnore(const tocode, fromcode: Ansistring): iconv_t;
104function SynaIconv(cd: iconv_t; inbuf: AnsiString; var outbuf: AnsiString): integer;
105function SynaIconvClose(var cd: iconv_t): integer;
106function SynaIconvCtl(cd: iconv_t; request: integer; argument: argptr): integer;
107
108function IsIconvloaded: Boolean;
109function InitIconvInterface: Boolean;
110function DestroyIconvInterface: Boolean;
111
112const
113 ICONV_TRIVIALP = 0; // int *argument
114 ICONV_GET_TRANSLITERATE = 1; // int *argument
115 ICONV_SET_TRANSLITERATE = 2; // const int *argument
116 ICONV_GET_DISCARD_ILSEQ = 3; // int *argument
117 ICONV_SET_DISCARD_ILSEQ = 4; // const int *argument
118
119
120implementation
121
122uses SyncObjs;
123
124{$IFDEF CIL}
125 [DllImport(DLLIconvName, CharSet = CharSet.Ansi,
126 SetLastError = False, CallingConvention= CallingConvention.cdecl,
127 EntryPoint = 'libiconv_open')]
128 function _iconv_open(tocode: string; fromcode: string): iconv_t; external;
129
130 [DllImport(DLLIconvName, CharSet = CharSet.Ansi,
131 SetLastError = False, CallingConvention= CallingConvention.cdecl,
132 EntryPoint = 'libiconv')]
133 function _iconv(cd: iconv_t; var inbuf: IntPtr; var inbytesleft: size_t;
134 var outbuf: IntPtr; var outbytesleft: size_t): size_t; external;
135
136 [DllImport(DLLIconvName, CharSet = CharSet.Ansi,
137 SetLastError = False, CallingConvention= CallingConvention.cdecl,
138 EntryPoint = 'libiconv_close')]
139 function _iconv_close(cd: iconv_t): integer; external;
140
141 [DllImport(DLLIconvName, CharSet = CharSet.Ansi,
142 SetLastError = False, CallingConvention= CallingConvention.cdecl,
143 EntryPoint = 'libiconvctl')]
144 function _iconvctl(cd: iconv_t; request: integer; argument: argptr): integer; external;
145
146{$ELSE}
147type
148 Ticonv_open = function(tocode: pAnsichar; fromcode: pAnsichar): iconv_t; cdecl;
149 Ticonv = function(cd: iconv_t; var inbuf: pointer; var inbytesleft: size_t;
150 var outbuf: pointer; var outbytesleft: size_t): size_t; cdecl;
151 Ticonv_close = function(cd: iconv_t): integer; cdecl;
152 Ticonvctl = function(cd: iconv_t; request: integer; argument: argptr): integer; cdecl;
153var
154 _iconv_open: Ticonv_open = nil;
155 _iconv: Ticonv = nil;
156 _iconv_close: Ticonv_close = nil;
157 _iconvctl: Ticonvctl = nil;
158{$ENDIF}
159
160
161var
162 IconvCS: TCriticalSection;
163 Iconvloaded: boolean = false;
164
165function SynaIconvOpen (const tocode, fromcode: Ansistring): iconv_t;
166begin
167{$IFDEF CIL}
168 try
169 Result := _iconv_open(tocode, fromcode);
170 except
171 on Exception do
172 Result := iconv_t(-1);
173 end;
174{$ELSE}
175 if InitIconvInterface and Assigned(_iconv_open) then
176 Result := _iconv_open(PAnsiChar(tocode), PAnsiChar(fromcode))
177 else
178 Result := iconv_t(-1);
179{$ENDIF}
180end;
181
182function SynaIconvOpenTranslit (const tocode, fromcode: Ansistring): iconv_t;
183begin
184 Result := SynaIconvOpen(tocode + '//IGNORE//TRANSLIT', fromcode);
185end;
186
187function SynaIconvOpenIgnore (const tocode, fromcode: Ansistring): iconv_t;
188begin
189 Result := SynaIconvOpen(tocode + '//IGNORE', fromcode);
190end;
191
192function SynaIconv (cd: iconv_t; inbuf: AnsiString; var outbuf: AnsiString): integer;
193var
194{$IFDEF CIL}
195 ib, ob: IntPtr;
196 ibsave, obsave: IntPtr;
197 l: integer;
198{$ELSE}
199 ib, ob: Pointer;
200{$ENDIF}
201 ix, ox: size_t;
202begin
203{$IFDEF CIL}
204 l := Length(inbuf) * 4;
205 ibsave := IntPtr.Zero;
206 obsave := IntPtr.Zero;
207 try
208 ibsave := Marshal.StringToHGlobalAnsi(inbuf);
209 obsave := Marshal.AllocHGlobal(l);
210 ib := ibsave;
211 ob := obsave;
212 ix := Length(inbuf);
213 ox := l;
214 _iconv(cd, ib, ix, ob, ox);
215 Outbuf := Marshal.PtrToStringAnsi(obsave, l);
216 setlength(Outbuf, l - ox);
217 Result := Length(inbuf) - ix;
218 finally
219 Marshal.FreeCoTaskMem(ibsave);
220 Marshal.FreeHGlobal(obsave);
221 end;
222{$ELSE}
223 if InitIconvInterface and Assigned(_iconv) then
224 begin
225 setlength(Outbuf, Length(inbuf) * 4);
226 ib := Pointer(inbuf);
227 ob := Pointer(Outbuf);
228 ix := Length(inbuf);
229 ox := Length(Outbuf);
230 _iconv(cd, ib, ix, ob, ox);
231 setlength(Outbuf, cardinal(Length(Outbuf)) - ox);
232 Result := Cardinal(Length(inbuf)) - ix;
233 end
234 else
235 begin
236 Outbuf := '';
237 Result := 0;
238 end;
239{$ENDIF}
240end;
241
242function SynaIconvClose(var cd: iconv_t): integer;
243begin
244 if cd = iconv_t(-1) then
245 begin
246 Result := 0;
247 Exit;
248 end;
249{$IFDEF CIL}
250 try;
251 Result := _iconv_close(cd)
252 except
253 on Exception do
254 Result := -1;
255 end;
256 cd := iconv_t(-1);
257{$ELSE}
258 if InitIconvInterface and Assigned(_iconv_close) then
259 Result := _iconv_close(cd)
260 else
261 Result := -1;
262 cd := iconv_t(-1);
263{$ENDIF}
264end;
265
266function SynaIconvCtl (cd: iconv_t; request: integer; argument: argptr): integer;
267begin
268{$IFDEF CIL}
269 Result := _iconvctl(cd, request, argument)
270{$ELSE}
271 if InitIconvInterface and Assigned(_iconvctl) then
272 Result := _iconvctl(cd, request, argument)
273 else
274 Result := 0;
275{$ENDIF}
276end;
277
278function InitIconvInterface: Boolean;
279begin
280 IconvCS.Enter;
281 try
282 if not IsIconvloaded then
283 begin
284{$IFDEF CIL}
285 IconvLibHandle := 1;
286{$ELSE}
287 IconvLibHandle := LoadLibrary(PChar(DLLIconvName));
288{$ENDIF}
289 if (IconvLibHandle <> 0) then
290 begin
291{$IFNDEF CIL}
292 _iconv_open := GetProcAddress(IconvLibHandle, PAnsiChar(AnsiString('libiconv_open')));
293 _iconv := GetProcAddress(IconvLibHandle, PAnsiChar(AnsiString('libiconv')));
294 _iconv_close := GetProcAddress(IconvLibHandle, PAnsiChar(AnsiString('libiconv_close')));
295 _iconvctl := GetProcAddress(IconvLibHandle, PAnsiChar(AnsiString('libiconvctl')));
296{$ENDIF}
297 Result := True;
298 Iconvloaded := True;
299 end
300 else
301 begin
302 //load failed!
303 if IconvLibHandle <> 0 then
304 begin
305{$IFNDEF CIL}
306 FreeLibrary(IconvLibHandle);
307{$ENDIF}
308 IconvLibHandle := 0;
309 end;
310 Result := False;
311 end;
312 end
313 else
314 //loaded before...
315 Result := true;
316 finally
317 IconvCS.Leave;
318 end;
319end;
320
321function DestroyIconvInterface: Boolean;
322begin
323 IconvCS.Enter;
324 try
325 Iconvloaded := false;
326 if IconvLibHandle <> 0 then
327 begin
328{$IFNDEF CIL}
329 FreeLibrary(IconvLibHandle);
330{$ENDIF}
331 IconvLibHandle := 0;
332 end;
333{$IFNDEF CIL}
334 _iconv_open := nil;
335 _iconv := nil;
336 _iconv_close := nil;
337 _iconvctl := nil;
338{$ENDIF}
339 finally
340 IconvCS.Leave;
341 end;
342 Result := True;
343end;
344
345function IsIconvloaded: Boolean;
346begin
347 Result := IconvLoaded;
348end;
349
350 initialization
351begin
352 IconvCS:= TCriticalSection.Create;
353end;
354
355finalization
356begin
357{$IFNDEF CIL}
358 DestroyIconvInterface;
359{$ENDIF}
360 IconvCS.Free;
361end;
362
363end.
Note: See TracBrowser for help on using the repository browser.