source: Network/synapse/synaicnv.pas

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