|
|||||
このプログラムは以下のモジュールを使用しています。 ADODB.Streamによる文字コード変換のサンプル(VB6) WideCharToMultiByteとMultiByteToWideCharによる文字コード変換のサンプル(VB6) 文字コード判定のサンプル(VB6) <このサンプルの概要> 「ADODB.Streamによる文字コード変換のサンプル」のモジュールと「WideCharToMultiByte とMultiByteToWideCharによる文字コード変換のサンプル」のモジュールを使用しSJIS、 JIS、EUC、UTF-7、UTF-8からVB6内部文字コードであるUNICODE(UTF-16) に変換します。 またUNICODEからの逆変換もします。全ての文字コードをUNICODE に変換出来て、その逆 変換も出来れば全ての文字コード間の変換がUNICODEを通して出来る事になります。 UNICODEを通す事による処理速度等は気にしていません。 その他の機能としては「文字コード判定のサンプル」のモジュールによる文字コード判定、 BOM 付加/削除、改行コードがあります。100%完璧な文字コード判定は難しいですが 出来るだけ精度の高い判定を目指しています。BOM とはUNICODEやUTF-8を判別するために ファイルの先頭付くコードで、UNICODE の時は&HFF,&HFE、UTF-8の時は&HEF,&HBB,&HBFで す。 Option Explicit '********************************************************************** ' 機能名 : NonCodeClass.cls ' 機能説明 : 文字コード変換クラス ' 備考 : 現在は、ADODB.Streamによる文字コード変換と ' : WideCharToMultiByteとMultiByteToWideCharによる ' : 文字コード変換をサポート ' 著作権 : Copyright(C) 2007 のん All right reserved ' : このプログラムは、日本国著作権法および国際条約により保護 ' : されています。このプログラムを転載する場合は著作権所有者 ' : の許可が必要となります。 '********************************************************************** Private fRogic As Integer ' 0:ADODB.Streamによる文字コード変換 ' 1:WideCharToMultiByte等による文字コード変換 '---文字コード変換ロジックプロパティ ' 関数名 : FuncRogic ' 返り値 : 文字コード変換ロジックプロパティ ' 引き数 : 無し ' 機能説明 : 文字コード変換ロジックプロパティ取得 ' 備考 : 0:ADODB.Streamによる文字コード変換 ' : 1:WideCharToMultiByte等による文字コード変換 Public Property Get FuncRogic() As Long FuncRogic = fRogic End Property ' 関数名 : FuncRogic ' 返り値 : 無し ' 引き数 : mode : 文字コード変換ロジックプロパティ ' 機能説明 : 文字コード変換ロジックプロパティ設定 ' 備考 : 0:ADODB.Streamによる文字コード変換 ' : 1:WideCharToMultiByte等による文字コード変換 Public Property Let FuncRogic(ByVal mode As Long) fRogic = mode If fRogic < 0 Then fRogic = 0 If fRogic > 1 Then fRogic = 0 End Property '---文字コード判定関係 ' 関数名 : GetCodeName ' 返り値 : 判定結果文字コード名 ' 引き数 : bytCode : 判定文字データ ' 機能説明 : 文字コードを判定する ' 備考 : Public Function GetCodeName(ByRef bytCode() As Byte) As String GetCodeName = JudgeCode(bytCode) End Function '---UNICODE関係 ' 関数名 : UNICODE_To_VbUnicode ' 返り値 : UNICODE文字列 ' 引き数 : bytCode : UNICODE文字データ ' 機能説明 : UNICODE文字データをUNICODEに変換する ' 備考 : Public Function UNICODE_To_VbUnicode(ByRef bytCode() As Byte) As String Dim BOM(1) As Byte BOM(0) = &HFF BOM(1) = &HFE UNICODE_To_VbUnicode = CutBOM(bytCode, BOM) End Function ' 関数名 : VbUnicode_To_UNICODE ' 返り値 : UNICODE文字データ ' 引き数 : strUni : UNICODE文字データ ' : BOMflag : BOMを付加するかどうか ' 機能説明 : UNICODE文字データをUNICODEに変換する ' 備考 : Public Function VbUnicode_To_UNICODE( _ ByVal strUni As String, Optional ByVal BOMflag As Boolean = False) As Byte() If BOMflag Then Dim BOM(1) As Byte BOM(0) = &HFF BOM(1) = &HFE Dim bytTmp() As Byte bytTmp = strUni VbUnicode_To_UNICODE = AddBOM(bytTmp, BOM) Else VbUnicode_To_UNICODE = strUni End If End Function '---Shift-JIS関係 ' 関数名 : SJIS_To_VbUnicode ' 返り値 : UNICODE文字列 ' 引き数 : bytCode : SJIS文字データ ' 機能説明 : SJIS文字データをUNICODEに変換する ' 備考 : Public Function SJIS_To_VbUnicode(ByRef bytCode() As Byte) As String 'SJIS_To_VbUnicode = StrConv(bytCode, vbUnicode) If fRogic = 0 Then SJIS_To_VbUnicode = ADOS_Decode_SJIS(bytCode) Else SJIS_To_VbUnicode = WCMB_Decode_SJIS(bytCode) End If End Function ' 関数名 : VbUnicode_To_SJIS ' 返り値 : SJIS文字データ ' 引き数 : strUni : UNICODE文字データ ' 機能説明 : UNICODE文字データをSJISに変換する ' 備考 : Public Function VbUnicode_To_SJIS(ByVal strUni As String) As Byte() 'VbUnicode_To_SJIS = StrConv(strUni, vbFromUnicode) If fRogic = 0 Then VbUnicode_To_SJIS = ADOS_Encode_SJIS(strUni) Else VbUnicode_To_SJIS = WCMB_Encode_SJIS(strUni) End If End Function '---JIS関係 ' 関数名 : JIS_To_VbUnicode ' 返り値 : UNICODE文字列 ' 引き数 : bytCode : JIS文字データ ' 機能説明 : JIS文字データをUNICODEに変換する ' 備考 : Public Function JIS_To_VbUnicode(ByRef bytCode() As Byte) As String If fRogic = 0 Then JIS_To_VbUnicode = ADOS_Decode_JIS(bytCode) Else JIS_To_VbUnicode = WCMB_Decode_JIS(bytCode) End If End Function ' 関数名 : VbUnicode_To_JIS ' 返り値 : JIS文字データ ' 引き数 : strUni : UNICODE文字データ ' 機能説明 : UNICODE文字データをJISに変換する ' 備考 : Public Function VbUnicode_To_JIS(ByVal strUni As String) As Byte() If fRogic = 0 Then VbUnicode_To_JIS = ADOS_Encode_JIS(strUni) Else VbUnicode_To_JIS = WCMB_Encode_JIS(strUni) End If End Function '---EUC関係 ' 関数名 : EUC_To_VbUnicode ' 返り値 : UNICODE文字列 ' 引き数 : bytCode : EUC文字データ ' 機能説明 : EUC文字データをUNICODEに変換する ' 備考 : Public Function EUC_To_VbUnicode(ByRef bytCode() As Byte) As String If fRogic = 0 Then EUC_To_VbUnicode = ADOS_Decode_EUC(bytCode) Else EUC_To_VbUnicode = WCMB_Decode_EUC(bytCode) End If End Function ' 関数名 : VbUnicode_To_EUC ' 返り値 : EUC文字データ ' 引き数 : strUni : UNICODE文字データ ' 機能説明 : UNICODE文字データをEUCに変換する ' 備考 : Public Function VbUnicode_To_EUC(ByVal strUni As String) As Byte() If fRogic = 0 Then VbUnicode_To_EUC = ADOS_Encode_EUC(strUni) Else VbUnicode_To_EUC = WCMB_Encode_EUC(strUni) End If End Function '---UTF-7関係 ' 関数名 : UTF7_To_VbUnicode ' 返り値 : UNICODE文字列 ' 引き数 : bytCode : EUTF7文字データ ' 機能説明 : UTF7文字データをUNICODEに変換する ' 備考 : Public Function UTF7_To_VbUnicode(ByRef bytCode() As Byte) As String If fRogic = 0 Then UTF7_To_VbUnicode = ADOS_Decode_UTF7(bytCode) Else UTF7_To_VbUnicode = WCMB_Decode_UTF7(bytCode) End If End Function ' 関数名 : VbUnicode_To_UTF7 ' 返り値 : UTF7文字データ ' 引き数 : strUni : UNICODE文字データ ' 機能説明 : UNICODE文字データをUTF7に変換する ' 備考 : Public Function VbUnicode_To_UTF7(ByVal strUni As String) As Byte() If fRogic = 0 Then VbUnicode_To_UTF7 = ADOS_Encode_UTF7(strUni) Else VbUnicode_To_UTF7 = WCMB_Encode_UTF7(strUni) End If End Function '---UTF-8関係 ' 関数名 : UTF8_To_VbUnicode ' 返り値 : UNICODE文字列 ' 引き数 : bytCode : EUTF8文字データ ' 機能説明 : UTF8文字データをUNICODEに変換する ' 備考 : Public Function UTF8_To_VbUnicode(ByRef bytCode() As Byte) As String Dim BOM(2) As Byte BOM(0) = &HEF BOM(1) = &HBB BOM(2) = &HBF If fRogic = 0 Then UTF8_To_VbUnicode = ADOS_Decode_UTF8(CutBOM(bytCode, BOM)) Else UTF8_To_VbUnicode = WCMB_Decode_UTF8(CutBOM(bytCode, BOM)) End If End Function ' 関数名 : VbUnicode_To_UTF8 ' 返り値 : UTF8文字データ ' 引き数 : strUni : UNICODE文字データ ' : BOMflag : BOMを付加するかどうか ' 機能説明 : UNICODE文字データをUTF8に変換する ' 備考 : Public Function VbUnicode_To_UTF8( _ ByVal strUni As String, Optional ByVal BOMflag As Boolean = False) As Byte() Dim bytTmp() As Byte If fRogic = 0 Then bytTmp = ADOS_Encode_UTF8(strUni) Else bytTmp = WCMB_Encode_UTF8(strUni) End If If BOMflag Then Dim BOM(2) As Byte BOM(0) = &HEF BOM(1) = &HBB BOM(2) = &HBF VbUnicode_To_UTF8 = AddBOM(bytTmp, BOM) Else VbUnicode_To_UTF8 = bytTmp End If End Function '---BOM操作関係 ' 関数名 : CutBOM ' 返り値 : BOMをカットしたデータ ' 引き数 : bytCode : BOMをカットする前の文字データ ' : BOMflag : BOMバイト列 ' 機能説明 : 文字データから指定のBOMをカットする ' 備考 : Public Function CutBOM(ByRef bytCode() As Byte, ByRef BOM() As Byte) As Byte() Dim bytOut() As Byte Dim BOMflag As Boolean Dim i As Long Dim j As Long ReDim bytOut(-1 To -1) For i = 0 To UBound(bytCode) BOMflag = False If i <= UBound(bytCode) - UBound(BOM) Then For j = 0 To UBound(BOM) If bytCode(i + j) <> BOM(j) Then Exit For End If Next j If j > UBound(BOM) Then BOMflag = True i = i + UBound(BOM) End If End If If BOMflag = False Then If UBound(bytOut) < 0 Then ReDim bytOut(0) Else ReDim Preserve bytOut(UBound(bytOut) + 1) End If bytOut(UBound(bytOut)) = bytCode(i) End If Next i CutBOM = bytOut End Function ' 関数名 : AddBOM ' 返り値 : BOMを付加したデータ ' 引き数 : bytCode : BOMを付加する前の文字データ ' : BOMflag : BOMバイト列 ' 機能説明 : 文字データに指定のBOMを付加する ' 備考 : Public Function AddBOM(ByRef bytCode() As Byte, ByRef BOM() As Byte) As Byte() Dim i As Long Dim bytOut() As Byte ReDim bytOut(UBound(BOM)) For i = 0 To UBound(BOM) bytOut(i) = BOM(i) Next i For i = 0 To UBound(bytCode) ReDim Preserve bytOut(UBound(bytOut) + 1) bytOut(UBound(bytOut)) = bytCode(i) Next i AddBOM = bytOut End Function '---改行関係 ' 関数名 : CheckCrLf ' 返り値 : 改行コード ' 引き数 : strUni : 文字データ ' 機能説明 : 文字データに含まれる改行コードをチェックする ' 備考 : Public Function CheckCrLf(ByVal strUni As String) As String If InStr(strUni, vbCrLf) > 0 Then CheckCrLf = vbCrLf ElseIf InStr(strUni, vbLf) > 0 Then CheckCrLf = vbLf Else CheckCrLf = vbCrLf End If End Function ' 関数名 : ChangeCrLfToLf ' 返り値 : 改行コードをLFに変換した文字データ ' 引き数 : strUni : 変換前の文字データ ' 機能説明 : 文字データに含まれる改行コードをLFに変換する ' 備考 : Public Function ChangeCrLfToLf(ByVal strUni As String) As String ChangeCrLfToLf = Replace(strUni, vbCrLf, vbLf) End Function ' 関数名 : ChangeLfToCrLf ' 返り値 : 改行コードをCRLFに変換した文字データ ' 引き数 : strUni : 変換前の文字データ ' 機能説明 : 文字データに含まれる改行コードをCRLFに変換する ' 備考 : Public Function ChangeLfToCrLf(ByVal strUni As String) As String ChangeLfToCrLf = Replace(strUni, vbCrLf, vbLf) ChangeLfToCrLf = Replace(ChangeLfToCrLf, vbLf, vbCrLf) End Function |