Cybertune Δημοσ. 26 Ιανουαρίου 2006 Δημοσ. 26 Ιανουαρίου 2006 Θέλω να φτιάξω μια εφαρμογή που να δημιουργεί ένα αρχείο 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 το αρχείο στις δικές τους εφαρμογές) Έχει κανείς καμιά ιδέα? Θα εκτιμούσα την κάθε βοήθεια.
random Δημοσ. 26 Ιανουαρίου 2006 Δημοσ. 26 Ιανουαρίου 2006 η 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 δουλεύουν?? .....)
Cybertune Δημοσ. 26 Ιανουαρίου 2006 Μέλος Δημοσ. 26 Ιανουαρίου 2006 Κάνοντας chcp 1253 και ανοίγοντας το ίδιο αρχείο οι ελληνικοί χαρακτήρες πάλι εμφανίζονται το ίδιο. Παρ’ολα αυτά αν ας πούμε θέλω να φτάξω το αρχείο με codepage 737 (η οποιαδήποτε άλλη) ξέρει κανείς πως μπορώ να το κάνω αυτό? (Είναι ίσως κάποια παράμετρος που πρέπει να περάσω στο opentextfile η κάπου αλλού?) Όσο για το τι δουλεύουν αυτοί δεν έχω ιδέα, απλά μου ζήτησαν αρχείο ascii. Βασικά ανησυχώ προκαταβολικά για να μην υπάρχει πρόβλημα import.
random Δημοσ. 26 Ιανουαρίου 2006 Δημοσ. 26 Ιανουαρίου 2006 Βαλε ενα αρχειο μιας γραμμης εδω σαν attachment να το δούμε. το string που γραφεις μεσα, το εχεις γραψει καρφωτά μεσα σε ενα variable στον κωδικά, ή το γράφεις σε ενα textbox, και το παιρνεις απο εκει κατα την εκτέλεση ή απο μια database ?
Cybertune Δημοσ. 26 Ιανουαρίου 2006 Μέλος Δημοσ. 26 Ιανουαρίου 2006 Έχω κάνει attach ένα αρχείο με 2 γραμμές. Και οι δύο γράφουν (ή θα έπρεπε να γράφουν): "αυτοειναιεναπαραδειγμα" Στη πρώτη γράφω την γραμμή με το text property ενός textbox. Στη δεύτερη την γράφω με string variable που έχω κάνει assign το value "αυτοειναιεναπαραδειγμα" Όπως θα δείτε οι γραμμές είναι ακριβώς ίδιες (οπότε μάλλον το πρόβλημα, αν υπάρχει πρόβλημα, δεν είναι στα properties του textbox) Ευχαριστώ για την βοήθεια! test.txt
Sta Δημοσ. 26 Ιανουαρίου 2006 Δημοσ. 26 Ιανουαρίου 2006 Στις κωδικοσελίδες windows-1253 και iso-8859 είναι κανονικά αναγνώσιμο, δοκίμασε στο notepad π.χ. με font Arial. Στο DOS, όπως είπε και ο random, παίζει η 737. Αυτό για το οποίο δε γνωρίζω είναι εάν μπορεί κάποιος να δει ελληνικά μέσα από τον edit. Επίσης, υποθέτω ότι η VB ζητάει τη συμβουλή του λειτουργικού (κατάλληλη κωδικοσελίδα) για να γράψει τα ελληνικά σε κάποιο αρχείο. Αν θέλεις -σώνει και καλά- να έχεις ελληνικά σε 737 υπάρχουν editors που μπορούν να κάνουν τη μετατροπή.
random Δημοσ. 26 Ιανουαρίου 2006 Δημοσ. 26 Ιανουαρίου 2006 Αυτο ειναι ενα κανονικοτατο αρχειο 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
Sta Δημοσ. 27 Ιανουαρίου 2006 Δημοσ. 27 Ιανουαρίου 2006 Εμένα αυτό με το: chcp 1253 και μετά άνοιγμα με edit ή type, δε μου παίζει για κάποιο λόγο. Εμφανίζονται πάλι κινέζικα.
alkisg Δημοσ. 27 Ιανουαρίου 2006 Δημοσ. 27 Ιανουαρίου 2006 Το πρόγραμμα δηλαδή το γράφεις στη 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
random Δημοσ. 27 Ιανουαρίου 2006 Δημοσ. 27 Ιανουαρίου 2006 ...και θες να έχει σαν αποτέλεσμα DOS, δηλαδή 737 Το θεμα ειναι, οτι ακομα δεν ξερει αν οι αποδέκτες του αρχειου ενδιαφέρονται για 737. Η ανησυχια του ξεκiνησε επειδη προσπαθει να δει το αρχειο με το edit.com ειναι υπαρκτό πρόβλημα αυτό or we're distilling the mosquito?
sotospez Δημοσ. 30 Ιανουαρίου 2006 Δημοσ. 30 Ιανουαρίου 2006 '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
CyberDreamer Δημοσ. 3 Φεβρουαρίου 2006 Δημοσ. 3 Φεβρουαρίου 2006 Παιδες... εγω τουλάχιστον για τον 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
g_charal Δημοσ. 10 Δεκεμβρίου 2007 Δημοσ. 10 Δεκεμβρίου 2007 Οι δημόσιοι οργανισμοί θέλουν ASCII/DOS. Καλά κάνει και ψάχνεται.
Προτεινόμενες αναρτήσεις
Αρχειοθετημένο
Αυτό το θέμα έχει αρχειοθετηθεί και είναι κλειστό για περαιτέρω απαντήσεις.