- unit unilib;
- interface
- uses
- Windows;
- const
- IID_MLangConvertCharset: TGUID = '{D66D6F98-CDAA-11D0-B822-00C04FC9B31F}';
- CLASS_MLangConvertCharset :TGUID = '{D66D6F99-CDAA-11D0-B822-00C04FC9B31F}';
- type
- tagMLCONVCHARF = DWORD;
- const
- MLCONVCHARF_AUTODETECT: tagMLCONVCHARF = 1;
- MLCONVCHARF_ENTITIZE : tagMLCONVCHARF = 2;
- type
- tagCODEPAGE = UINT;
- const
- CODEPAGE_Thai : tagCODEPAGE = 0874;
- CODEPAGE_Japanese : tagCODEPAGE = 0932;
- CODEPAGE_Chinese_PRC : tagCODEPAGE = 0936;
- CODEPAGE_Korean : tagCODEPAGE = 0949;
- CODEPAGE_Chinese_Taiwan : tagCODEPAGE = 0950;
- CODEPAGE_UniCode : tagCODEPAGE = 1200;
- CODEPAGE_Windows_31_EastEurope : tagCODEPAGE = 1250;
- CODEPAGE_Windows_31_Cyrillic : tagCODEPAGE = 1251;
- CODEPAGE_Windows_31_Latin1 : tagCODEPAGE = 1252;
- CODEPAGE_Windows_31_Greek : tagCODEPAGE = 1253;
- CODEPAGE_Windows_31_Turkish : tagCODEPAGE = 1254;
- CODEPAGE_Hebrew : tagCODEPAGE = 1255;
- CODEPAGE_Arabic : tagCODEPAGE = 1256;
- CODEPAGE_Baltic : tagCODEPAGE = 1257;
- type
- IMLangConvertCharset = interface
- ['{D66D6F98-CDAA-11D0-B822-00C04FC9B31F}']
- function Initialize(
- uiSrcCodePage: tagCODEPAGE; uiDstCodePage: tagCODEPAGE;
- dwProperty: tagMLCONVCHARF
- ): HResult; stdcall;
- function GetSourceCodePage(
- out puiSrcCodePage: tagCODEPAGE
- ): HResult; stdcall;
- function GetDestinationCodePage(
- out puiDstCodePage: tagCODEPAGE
- ): HResult; stdcall;
- function GetProperty(out pdwProperty: tagMLCONVCHARF): HResult; stdcall;
- function DoConversion(
- pSrcStr: PChar; pcSrcSize: PUINT; pDstStr: PChar; pcDstSize: PUINT
- ): HResult; stdcall;
- function DoConversionToUnicode(
- pSrcStr: PChar; pcSrcSize: PUINT; pDstStr: PWChar; pcDstSize: PUINT
- ): HResult; stdcall;
- function DoConversionFromUnicode(
- pSrcStr: PWChar; pcSrcSize: PUINT; pDstStr: PChar; pcDstSize: PUINT
- ): HResult; stdcall;
- end;
- CoMLangConvertCharset = class
- class function Create: IMLangConvertCharset;
- class function CreateRemote(const MachineName: string): IMLangConvertCharset;
- end;
- function TransferUnicodeToCodePage(ToCP:tagCODEPAGE;SText:WideString):String;
- function TransferCodePageToUnicode(FromCP:tagCODEPAGE;QText:String):WideString;
- procedure WriteLnW(var _F : File; const _S : WideString);
- procedure ReadLnW(var _F : File; var _S : WideString);
- implementation
- uses
- ComObj;
- // CoMLangConvertCharset
- // *****************************************************************************
- class function CoMLangConvertCharset.Create: IMLangConvertCharset;
- begin
- Result := CreateComObject(CLASS_MLangConvertCharset) as IMLangConvertCharset;
- end;
- class function CoMLangConvertCharset.CreateRemote(
- const MachineName: string): IMLangConvertCharset;
- begin
- Result := CreateRemoteComObject(
- MachineName, CLASS_MLangConvertCharset) as IMLangConvertCharset;
- end;
- // Unicode Routines
- // *****************************************************************************
- function TransferUnicodeToCodePage(ToCP:tagCODEPAGE;SText:WideString):String;
- var
- Conv: IMLangConvertCharset;
- Source: PWChar;
- Dest: PChar;
- SourceSize, DestSize: UINT;
- begin
- Conv := CoMLangConvertCharset.Create;
- Conv.Initialize(CODEPAGE_UniCode,ToCP, MLCONVCHARF_ENTITIZE);
- Source := PWChar(SText);
- SourceSize := Succ(Length(SText));
- DestSize := 0;
- Conv.DoConversionFromUnicode(Source, @SourceSize, nil, @DestSize);
- Getmem(Dest, DestSize);
- try
- Conv.DoConversionFromUnicode(Source, @SourceSize, Dest, @DestSize);
- result:= Dest;
- finally
- FreeMem(Dest);
- end;
- end;
- function TransferCodePageToUnicode(FromCP:tagCODEPAGE;QText:String):WideString;
- var
- Conv: IMLangConvertCharset;
- Dest: WideString;
- SourceSize, DestSize: UINT;
- begin
- Conv:= CoMLangConvertCharset.Create;
- Conv.Initialize(FromCP, CODEPAGE_UniCode, MLCONVCHARF_ENTITIZE);
- SourceSize := length(QText);
- DestSize := 0;
- Conv.DoConversionToUnicode(PChar(QText),@SourceSize,nil,@DestSize);
- SetLength(Dest,DestSize);
- try
- Conv.DoConversionToUnicode(PChar(QText),@SourceSize,PWChar(Dest),@DestSize);
- finally
- result:=Dest;
- Finalize(Dest);
- end;
- end;
- procedure WriteLnW(var _F : File; const _S : WideString);
- var
- C : WideChar;
- begin
- BlockWrite(_F, _S[1], Length(_S)*SizeOf(WideChar));
- C := WideChar(#13);
- BlockWrite(_F, C, SizeOf(WideChar));
- C := WideChar(#10);
- BlockWrite(_F, C, SizeOf(WideChar));
- end;
- procedure ReadLnW(var _F : File; var _S : WideString);
- var
- C : WideChar;
- CRLF : Boolean;
- Buffer : WideString;
- begin
- CRLF := False;
- Buffer := '';
- while (not EOF(_F)) and (not CRLF) do
- begin
- BlockRead(_F, C, SizeOf(WideChar));
- if (C = #13) then
- begin
- if (not EOF(_F)) then
- begin
- BlockRead(_F, C, SizeOf(WideChar));
- if (C = #10) then
- CRLF := True;
- end;
- end
- else
- Buffer := Buffer + C;
- end;
- _S := Buffer;
- end;