Προς το περιεχόμενο

Πρόβλημα στην δημιουργία αρχείου ascii με ελληνικούς χαρακτήρες. (Με visual basic 6)


Cybertune

Προτεινόμενες αναρτήσεις

Δημοσ.

Θέλω να φτιάξω μια εφαρμογή που να δημιουργεί ένα αρχείο ascii με συγκεκριμένη γραμμογράφηση (Το αρχείο είναι για την κάταθεση στοιχείων ασφαλισμένων σε κάποιο ασφαλιστικό οργανισμό). Χρησιμοποιώ το file system object και συγκεκρίμένα τον κώδικα

Set ts = fso.OpenTextFile("C:\test.txt", ForAppending, True)

ts.WriteLine (string)

για να ανοίξω το αρχείο και να γράψω μια γραμμή σε αυτό.

Όλα δουλεύουν άψογα μέχρι που πάω να γράψω κάποιο string με ελληνικούς χαρακτήρες. Τότε, ανοίγοντας το αρχείο με τον editor του dos, οι συγκεκριμένοι χαρακτηρες εμφανίζονται "κινεζικοι". To ίδιο συμβαίνει αν ανοίξω το αρχείο με το notepad χρησιμοποιόντας το font "Terminal". Επειδή έχω ανοίξει πολλές φορές αρχεία ascii που περιέχουν ελληνικούς χαρακτήρες

με τον editor του DOS (αλλά και με notepad) και ποτέ δεν είχα πρόβλημα, υποψιάζομαι ότι εγώ κάνω κάτι λάθος.(Και ότι κατα συνέποια οι κύριοι του οργανισμού δεν θα μπορούν να κάνουν import το αρχείο στις δικές τους εφαρμογές)

Έχει κανείς καμιά ιδέα?

Θα εκτιμούσα την κάθε βοήθεια.

Δημοσ.

η vb προφανώς φτιαχνει το αρχειο με windows codepage (99,999% ειναι η 1253).

ο dos editor, η γραμμη εντολών κλπ παιζουν με dos codepage, που κατα 99,999% ειναι 737.

 

Tο notepad παιζει με οτι θελει γιατι ειναι μαπα.

βαλε ultraedit και ξεχνα τον.

 

 

γιατι επιλεγεις terminal? σε arial ή courier δεν θελεις?

 

η codepage sto dos αλλαζει με την εντολη chcp XXX (μονο για το τρέχων παράθυρο. δεν ειναι μονιμη η αλλαγή).

chcp σου δειχνει ποια ειναι ενεργη,

 

kane ... chcp 1253

και μετα ανοιξε τον dos editor.

 

αυτο δεν ειναι λυση βεβαια. απλα θα σου δειξει οτι το VB app εφτιαξε σωστα το αρχειο.

Μενει να αποφασίσεις αν θα τα φτιαχνεις σε 1253 ή 737, ανάλογα τι περιμένουν αυτοί. (ακόμα σε DOS δουλεύουν?? .....)

Δημοσ.

Κάνοντας chcp 1253 και ανοίγοντας το ίδιο αρχείο οι ελληνικοί χαρακτήρες πάλι εμφανίζονται το ίδιο. Παρ’ολα αυτά αν ας πούμε θέλω να φτάξω το αρχείο με codepage 737 (η οποιαδήποτε άλλη) ξέρει κανείς πως μπορώ να το κάνω αυτό? (Είναι ίσως κάποια παράμετρος που πρέπει να περάσω στο opentextfile η κάπου αλλού?)

 

Όσο για το τι δουλεύουν αυτοί δεν έχω ιδέα, απλά μου ζήτησαν αρχείο ascii. Βασικά ανησυχώ προκαταβολικά για να μην υπάρχει πρόβλημα import.

Δημοσ.

Βαλε ενα αρχειο μιας γραμμης εδω σαν attachment να το δούμε.

 

το string που γραφεις μεσα, το εχεις γραψει καρφωτά μεσα σε ενα variable στον κωδικά, ή το γράφεις σε ενα textbox, και το παιρνεις απο εκει κατα την εκτέλεση ή απο μια database ?

Δημοσ.

Έχω κάνει attach ένα αρχείο με 2 γραμμές. Και οι δύο γράφουν (ή θα έπρεπε να γράφουν):

"αυτοειναιεναπαραδειγμα"

 

Στη πρώτη γράφω την γραμμή με το text property ενός textbox.

Στη δεύτερη την γράφω με string variable που έχω κάνει assign το value "αυτοειναιεναπαραδειγμα"

 

Όπως θα δείτε οι γραμμές είναι ακριβώς ίδιες (οπότε μάλλον το πρόβλημα, αν υπάρχει πρόβλημα, δεν είναι στα properties του textbox)

 

Ευχαριστώ για την βοήθεια!

test.txt

Δημοσ.

Στις κωδικοσελίδες windows-1253 και iso-8859 είναι κανονικά αναγνώσιμο, δοκίμασε στο notepad π.χ. με font Arial. Στο DOS, όπως είπε και ο random, παίζει η 737. Αυτό για το οποίο δε γνωρίζω είναι εάν μπορεί κάποιος να δει ελληνικά μέσα από τον edit. Επίσης, υποθέτω ότι η VB ζητάει τη συμβουλή του λειτουργικού (κατάλληλη κωδικοσελίδα) για να γράψει τα ελληνικά σε κάποιο αρχείο. Αν θέλεις -σώνει και καλά- να έχεις ελληνικά σε 737 υπάρχουν editors που μπορούν να κάνουν τη μετατροπή.

Δημοσ.

Αυτο ειναι ενα κανονικοτατο αρχειο windows, kai φυσιολογικα σε 1253.

αν το επεξεργαστουν σε windows, δεν θα εχουν προβλημα.

 

για να το δεις σε "dos", command line πρεπει να δωσεις

 

chcp 1253

type test.txt

ή

edit test.txt

 

-----------------------------------

 

"χειρονακτική" μετατροπή γίνεται με τον ultraedit. πας file / conversions / ANSI to OEM

or OEM to ANSI..

 

στη δικη μας περιπτωση oem einai h 737, kai ansi h 1253.

 

---------------------------------------------------

απο vb δεν ξερω πολλα πραγματα για το πως θα τα φτιαξεις σε oem, αλλα αντι να κανεις τσάμπα δουλειά, καλυτερα να τους ρωτήσεις αν θελουν DOSίκα ελληνικά ή Παραθυρικά :)

 

επισης παρατήρησα οτι αν το μετατρεψεις σε unicode,

στην κονσόλα, ειτε δωσω chcp 737 ,ειτε 1253, με το

type test.txt εμφανίζονται κανονικά.

αλλα με το edit , όχι.

 

διαβασε λιγο εδώ http://www.cyberactivex.com/UnicodeTutorialVb.htm

 

http://www.dotnetzone.gr/cs/forums/7083/ShowPost.aspx

Δημοσ.

Εμένα αυτό με το: chcp 1253 και μετά άνοιγμα με edit ή type, δε μου παίζει για κάποιο λόγο. Εμφανίζονται πάλι κινέζικα.

Δημοσ.

Το πρόγραμμα δηλαδή το γράφεις στη Visual Basic, με 1253 κωδικοσελίδα, και θες να έχει σαν αποτέλεσμα DOS, δηλαδή 737 κωδικοσελίδα. Δύο λύσεις βλέπω:

 

1) Γράφεις σε 737 και όχι σε 1253. Δηλαδή σαν να λέμε το αρχείο Visual Basic να το κάνεις edit από το edit του DOS. Φυσικά υπάρχουν και άλλοι editors που σε αφήνουν να διαλέξεις την κωδικοσελίδα του αρχείου που επεξεργάζεσαι.

 

2) Πριν τα γράψεις σε αρχείο, κάνεις μετατροπή από 737 σε 1253. Αν η Visual Basic δεν προσφέρει έτοιμη συνάρτηση μετατροπής κωδικοσελίδων, μπορείς να φτιάξεις μία μόνος σου (με πινακάκι αντιστοίχισης) ή να χρησιμοποιήσεις τις δύο παρακάτω συναρτήσεις των Windows:

 

>
Private Declare Function MultiByteToWideChar Lib "kernel32" ( _
 ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, _
 ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, _
 ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, _
 ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, _
 lpUsedDefaultChar As Long) As Long

 

Πάρε κι ένα παράδειγμα πώς μετατρέπεται ένα string (=unicode, widestring) της Basic σε UTF-7. Εσύ πρέπει απλά να αλλάξεις την κωδικοσελίδα σε 737:

>
Public Function StrToUTF7(ByVal st As String) As String
 Dim stBuffer As String
 Dim cwch As Long
 Dim pwz As Long
 Dim pwzBuffer As Long
 Dim lpUsedDefaultChar As Long

 If Len(st) = 0 Then
   StrToUTF7 = ""
   Exit Function
 End If
 pwz = StrPtr(st)
 cwch = WideCharToMultiByte(CP_UTF7, ByVal 0&, pwz, -1, 0&, 0&, ByVal 0&, ByVal 0&)
 stBuffer = String$(cwch + 1, vbNullChar)
 pwzBuffer = StrPtr(stBuffer)
 cwch = WideCharToMultiByte(CP_UTF7, ByVal 0&, pwz, -1, pwzBuffer, Len(stBuffer), ByVal 0&, ByVal 0&)
 stBuffer = StrConv(stBuffer, vbUnicode)
 StrToUTF7 = Left$(stBuffer, cwch - 1)
End Function

Δημοσ.
...και θες να έχει σαν αποτέλεσμα DOS, δηλαδή 737

Το θεμα ειναι, οτι ακομα δεν ξερει αν οι αποδέκτες του αρχειου ενδιαφέρονται για 737. Η ανησυχια του ξεκiνησε επειδη προσπαθει να δει το αρχειο με το edit.com :)

ειναι υπαρκτό πρόβλημα αυτό or we're distilling the mosquito?

Δημοσ.

'Attribute VB_Name = "ModConvDos"

 

Option Compare Binary

Option Explicit

Public cnvUni2 As String

Public cnvUni As String

 

Public Const CP_ACP = 0

Public Const CP_NONE = 0

Public Const CP_OEMCP = 1

Public Const CP_WINANSI = 1004

Public Const CP_WINUNICODE = 1200

Public Const MB_PRECOMPOSED = &H1

Public Const MB_COMPOSITE = &H2

Public Const MB_USEGLYPHCHARS = &H4

 

' //Arabic

Public Const CP_AWIN = 101 ' //Bidi Windows codepage

Public Const CP_709 = 102 ' //MS-DOS Arabic Support CP 709

Public Const CP_720 = 103 ' //MS-DOS Arabic Support CP 720

Public Const CP_A708 = 104 ' //ASMO 708

Public Const CP_A449 = 105 ' //ASMO 449+

Public Const CP_TARB = 106 ' //MS Transparent Arabic

Public Const CP_NAE = 107 ' //Nafitha Enhanced Arabic Char Set

Public Const CP_V4 = 108 ' //Nafitha v 4.0

Public Const CP_MA2 = 109 ' //Mussaed Al Arabi (MA/2) CP 786

Public Const CP_I864 = 110 ' //IBM Arabic Supplement CP 864

Public Const CP_A437 = 111 ' //Ansi 437 codepage

Public Const CP_AMAC = 112 ' //Macintosh Cod Page

 

' //Hebrew

Public Const CP_HWIN = 201 ' //Bidi Windows codepage

Public Const CP_862I = 202 ' //IBM Hebrew Supplement CP 862

Public Const CP_7BIT = 203 ' //IBM Hebrew Supplement CP 862 Folded

Public Const CP_ISO = 204 ' //ISO Hebrew 8859-8 Character Set

Public Const CP_H437 = 205 ' //Ansi 437 codepage

Public Const CP_HMAC = 206 ' //Macintosh Cod Page

 

' /*************************************************************************

' Code Pages

' *************************************************************************/

Public Const CP_OEM_437 = 437

Public Const CP_ARABICDOS = 708

Public Const CP_DOS720 = 720

Public Const CP_IBM850 = 850

Public Const CP_IBM852 = 852

Public Const CP_DOS862 = 862

Public Const CP_IBM866 = 866

Public Const CP_THAI = 874

Public Const CP_JAPAN = 932

Public Const CP_CHINA = 936

Public Const CP_KOREA = 949

Public Const CP_TAIWAN = 950

Public Const CP_EASTEUROPE = 1250

Public Const CP_RUSSIAN = 1251

Public Const CP_WESTEUROPE = 1252

Public Const CP_GREEK = 1253

Public Const CP_TURKISH = 1254

Public Const CP_HEBREW = 1255

Public Const CP_ARABIC = 1256

Public Const CP_BALTIC = 1257

Public Const CP_VIETNAMESE = 1258

Public Const CP_ASCII = 20127

Public Const CP_RUSSIANKOI8R = 20866

Public Const CP_RUSSIANKOI8U = 21866

Public Const CP_ISOLATIN1 = 28591

Public Const CP_ISOEASTEUROPE = 28592

Public Const CP_ISOTURKISH = 28593

Public Const CP_ISOBALTIC = 28594

Public Const CP_ISORUSSIAN = 28595

Public Const CP_ISOARABIC = 28596

Public Const CP_ISOGREEK = 28597

Public Const CP_ISOHEBREW = 28598

Public Const CP_ISOTURKISH2 = 28599

Public Const CP_ISOLATIN9 = 28605

Public Const CP_HEBREWLOG = 38598

Public Const CP_USER = 50000

Public Const CP_AUTOALL = 50001

Public Const CP_JAPANNHK = 50220

Public Const CP_JAPANESC = 50221

Public Const CP_JAPANSIO = 50222

Public Const CP_KOREAISO = 50225

Public Const CP_TAIWANISO = 50227

Public Const CP_CHINAISO = 50229

Public Const CP_AUTOJAPAN = 50932

Public Const CP_AUTOCHINA = 50936

Public Const CP_AUTOKOREA = 50949

Public Const CP_AUTOTAIWAN = 50950

Public Const CP_AUTORUSSIAN = 51251

Public Const CP_AUTOGREEK = 51253

Public Const CP_AUTOARABIC = 51256

Public Const CP_JAPANEUC = 51932

Public Const CP_CHINAEUC = 51936

Public Const CP_KOREAEUC = 51949

Public Const CP_TAIWANEUC = 51950

Public Const CP_CHINAHZ = 52936

Public Const CP_MAC_ROMAN = 10000

Public Const CP_MAC_JAPAN = 10001

Public Const CP_MAC_ARABIC = 10004

Public Const CP_MAC_GREEK = 10006

Public Const CP_MAC_CYRILLIC = 10007

Public Const CP_MAC_LATIN2 = 10029

Public Const CP_MAC_TURKISH = 10081

#If Mac Then

Public Const CP_DEFAULT = CP_MACCP

#Else

Public Const CP_DEFAULT = CP_ACP

#End If

 

Public Const CP_JOHAB = 1361

Public Const CP_SYMBOL = 42

Public Const CP_UTF8 = 65001

Public Const CP_UTF7 = 65000

Public Const CP_UNICODELITTLE = 1200

Public Const CP_UNICODEBIG = 1201

Public Const CP_UNKNOWN = -1

 

Public Const MB_ERR_INVALID_CHARS = &H8 ' /* error for invalid chars */

 

Public Const WC_DEFAULTCHECK = &H100 ' /* check for default char */

Public Const WC_COMPOSITECHECK = &H200 ' /* convert composite to precomposed */

Public Const WC_DISCARDNS = &H10 ' /* discard non-spacing chars */

Public Const WC_SEPCHARS = &H20 ' /* generate separate chars */

Public Const WC_DEFAULTCHAR = &H40 ' /* replace w/ default char */

 

Private Type FONTSIGNATURE

fsUsb(4) As Long

fsCsb(2) As Long

End Type

 

Private Type CHARSETINFO

ciCharset As Long

ciACP As Long

fs As FONTSIGNATURE

End Type

 

Private Const LOCALE_IDEFAULTCODEPAGE = &HB

Private Const LOCALE_IDEFAULTANSICODEPAGE = &H1004

Private Const TCI_SRCCODEPAGE = 2

 

Private Declare Function GetACP Lib "Kernel32" () As Long

Private Declare Function GetLocaleInfoA Lib "Kernel32" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long

Private Declare Function GetSystemDefaultLCID Lib "Kernel32" () As Long

Private Declare Function IsWindowUnicode Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function TranslateCharsetInfo Lib "gdi32" (lpSrc As Long, lpcs As CHARSETINFO, ByVal dwFlags As Long) As Long

 

' The OS functions, if you prefer to use them

Private Declare Function MultiByteToWideChar Lib "Kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long

Private Declare Function WideCharToMultiByte Lib "Kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, lpUsedDefaultChar As Long) As Long

 

' Now, pick which dll to use and comment out the other ones.

'Private Declare Function MsoCpgFromLid Lib "c:\program files\Microsoft Office 9\office\mso9.dll" Alias "#307" (ByVal lid As Long) As Long

'Private Declare Function MsoCpgFromLid Lib "c:\program files\Microsoft Office 8\office\mso97.dll" Alias "#307" (ByVal lid As Long) As Long

Private Declare Function MsoCpgFromLid Lib "c:\program files\common files\microsoft shared\vba\mso97rt.dll" Alias "#307" (ByVal lid As Long) As Long

'Private Declare Function MsoMultiByteToWideChar Lib "c:\program files\Microsoft Office 9\office\mso9.dll" Alias "#778" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long

'Private Declare Function MsoMultiByteToWideChar Lib "c:\program files\Microsoft Office 8\office\mso97.dll" Alias "#778" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long

Private Declare Function MsoMultiByteToWideChar Lib "c:\program files\common files\microsoft shared\vba\mso97rt.dll" Alias "#778" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long

'Private Declare Function MsoWideCharToMultiByte Lib "c:\program files\Microsoft Office 9\office\mso9.dll" Alias "#915" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, lpUsedDefaultChar As Long) As Long

'Private Declare Function MsoWideCharToMultiByte Lib "c:\program files\Microsoft Office 8\office\mso97.dll" Alias "#915" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, lpUsedDefaultChar As Long) As Long

Private Declare Function MsoWideCharToMultiByte Lib "c:\program files\common files\microsoft shared\vba\mso97rt.dll" Alias "#915" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, lpUsedDefaultChar As Long) As Long

 

'--------------------------------

' AToW

'

' ANSI to UNICODE conversion, via a given codepage.

'--------------------------------

Public Function AToW(ByVal st As String, Optional ByVal cpg As Long = -1, Optional lFlags As Long = 0) As String

Dim stBuffer As String

Dim cwch As Long

Dim pwz As Long

Dim pwzBuffer As Long

 

If cpg = -1 Then cpg = GetACP()

pwz = StrPtr(st)

cwch = MultiByteToWideChar(cpg, lFlags, pwz, -1, 0&, 0&)

stBuffer = String$(cwch + 1, vbNullChar)

pwzBuffer = StrPtr(stBuffer)

cwch = MultiByteToWideChar(cpg, lFlags, pwz, -1, pwzBuffer, Len(stBuffer))

AToW = Left$(stBuffer, cwch - 1)

End Function

 

'----------------------------------------------------------------------------------------

' AToWEx

'

' ANSI to UNICODE conversion, via a given an lcid.

'----------------------------------------------------------------------------------------

Public Function AToWEx(ByVal st As String, Optional ByVal lcid As Long = -1, Optional lFlags As Long = 0) As String

Dim cpg As Long

Dim lpUsedDefaultChar As Long

 

' If no codepage is specified, use the default system codepage

If lcid = -1 Then lcid = GetSystemDefaultLCID()

cpg = ChsFromLocaleEx(lcid)

 

AToWEx = AToW(st, cpg, lFlags)

End Function

 

'--------------------------------

' WToA

'

' UNICODE to ANSI conversion, via a given codepage

'--------------------------------

Public Function WToA(ByVal st As String, Optional ByVal cpg As Long = -1, Optional lFlags As Long = 0) As String

Dim stBuffer As String

Dim cwch As Long

Dim pwz As Long

Dim pwzBuffer As Long

Dim lpUsedDefaultChar As Long

 

If cpg = -1 Then cpg = GetACP()

pwz = StrPtr(st)

cwch = WideCharToMultiByte(cpg, lFlags, pwz, -1, 0&, 0&, ByVal 0&, ByVal 0&)

stBuffer = String$(cwch + 1, vbNullChar)

pwzBuffer = StrPtr(stBuffer)

cwch = WideCharToMultiByte(cpg, lFlags, pwz, -1, pwzBuffer, Len(stBuffer), ByVal 0&, ByVal 0&)

WToA = Left$(stBuffer, cwch - 1)

End Function

 

 

'----------------------------------------------------------------------------------------

' WToAEx

'

' UNICODE to ANSI conversion, via a given an lcid.

'----------------------------------------------------------------------------------------

Public Function WToAEx(ByVal st As String, Optional ByVal lcid As Long = -1, Optional lFlags As Long = 0) As String

Dim cpg As Long

Dim lpUsedDefaultChar As Long

 

' If no codepage is specified, use the default system codepage

If lcid = -1 Then lcid = GetSystemDefaultLCID()

cpg = ChsFromLocaleEx(lcid)

 

WToAEx = WToA(st, cpg, lFlags)

End Function

 

'----------------------------------------------------------------------------------------

' FStringInCpg

'

' Tests whether a particular string fits within a given codepage,

' given the string and a codepage.

'----------------------------------------------------------------------------------------

Public Function FStringInCpg(ByVal st As String, Optional ByVal cpg As Long = -1) As Boolean

Dim cwch As Long

Dim lpUsedDefaultChar As Long

 

' If no codepage is specified, use the default system codepage

If cpg = -1 Then cpg = GetACP()

 

' We are not converting, simply determining if the system plans

' on using the default char at all (which it does when it cannot

' map a char in the string)

cwch = MsoWideCharToMultiByte(cpg, 0&, StrPtr(st), -1, 0&, 0&, ByVal 0&, lpUsedDefaultChar)

FStringInCpg = (CBool(lpUsedDefaultChar) = False)

End Function

 

'----------------------------------------------------------------------------------------

' FStringInCpgEx

'

' Tests whether a particular string fits within a given codepage,

' given the string and an LCID.

'----------------------------------------------------------------------------------------

Public Function FStringInCpgEx(ByVal st As String, Optional ByVal lcid As Long = -1) As Boolean

Dim cwch As Long

Dim cpg As Long

Dim lpUsedDefaultChar As Long

 

' If no codepage is specified, use the default system codepage

If lcid = -1 Then lcid = GetSystemDefaultLCID()

cpg = ChsFromLocaleEx(lcid)

 

FStringInCpgEx = FStringInCpg(st, cpg)

End Function

 

'----------------------------------------------------------------------------------------

' ChsFromLocale

'

' The OS version

'----------------------------------------------------------------------------------------

Public Function ChsFromLocale(lcid As Long) As Long

Dim cwc As Long

Dim cpg As Long

Dim stBuffer As String

Dim cs As CHARSETINFO

 

stBuffer = String$(10, vbNullChar)

cwc = GetLocaleInfoA(lcid, LOCALE_IDEFAULTANSICODEPAGE, _

stBuffer, Len(stBuffer))

 

If cwc > 0 Then

cpg = Val(Left$(stBuffer, cwc - 1))

 

If TranslateCharsetInfo(ByVal cpg, cs, _

TCI_SRCCODEPAGE) Then

ChsFromLocale = cs.ciCharset

End If

End If

End Function

 

'----------------------------------------------------------------------------------------

' ChsFromLocaleEx

'

' The MSO version, much better at this sort of thing

'----------------------------------------------------------------------------------------

Public Function ChsFromLocaleEx(lcid As Long) As Long

ChsFromLocaleEx = MsoCpgFromLid(lcid)

End Function

 

'------------------------------

'gia ba bazo mono sto kimeno

'

'

'

Public Function EncodeDos(ByVal cnvUni As String)

If cnvUni = vbNullString Then Exit Function

EncodeDos = StrConv(WToA(cnvUni, CP_OEMCP, 0), vbUnicode)

End Function

'to decode an thelo to anapodo

Public Function DecodeDos(ByVal cnvUni As String)

If cnvUni = vbNullString Then Exit Function

cnvUni2 = WToA(cnvUni, CP_ACP)

DecodeDos = AToW(cnvUni2, CP_OEMCP)

End Function

 

-------------------------------------------------------------

 

opos einai se ena module bas kai meta EncodeDos i DecodeDos

Δημοσ.

Παιδες... εγω τουλάχιστον για τον dot matrix στέλνω τα παρακάτω... look them:

- ελπίζω να βοήθησα...

 

βάλτε και κανένα credit by CyberDreamer!

 

Function CONV2DOS(L$)

ABC$ = ""

ABC2$ = ""

For i = 1 To 24: ABC$ = ABC$ + Chr$(i + 127): Next i

For i = 1 To 17: ABC2$ = ABC2$ + Chr$(i + 192): Next i

For i = 1 To 7: ABC2$ = ABC2$ + Chr$(i + 210): Next i

 

For i = 1 To Len(L$)

If Asc(Mid$(L$, i, 1)) >= 192 And Asc(Mid$(L$, i, 1)) <= 209 Then

CONV2DOS = CONV2DOS + Mid$(ABC$, (Asc(Mid$(L$, i, 1)) - 192), 1)

End If

If Asc(Mid$(L$, i, 1)) >= 210 And Asc(Mid$(L$, i, 1)) <= 217 Then

CONV2DOS = CONV2DOS + Mid$(ABC$, (Asc(Mid$(L$, i, 1)) - 193), 1)

End If

If Asc(Mid$(L$, i, 1)) < 192 Then

CONV2DOS = CONV2DOS + Mid$(L$, i, 1)

End If

Next i

End Function

  • 1 χρόνο αργότερα...

Αρχειοθετημένο

Αυτό το θέμα έχει αρχειοθετηθεί και είναι κλειστό για περαιτέρω απαντήσεις.

  • Δημιουργία νέου...