Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Центр помощи > [VB6] Преобразование из ДОС-кодировки в Win


Автор: Voldemar2004 22.9.2005, 14:37
Есть какая-нибудь функция преобразования из ДОС-кодировки в Windows (dos 866-> win 866). Поле в Access имеет ДОС-кодировку, мне надо преобразовать в читабельный вид.

Автор: Akina 22.9.2005, 15:08
Код

Declare Function CharToOem     Lib "user32" Alias "CharToOemA" _ 
   (ByVal lpszSrc As String, ByVal lpszDst As String) As Long
Declare Function OemToChar     Lib "user32" Alias "OemToCharA" _
   (ByVal lpszSrc As String, ByVal lpszDst As String) As Long
Declare Function CharToOemBuff Lib "user32" Alias "CharToOemBuffA" _
   (ByVal lpszSrc As String, ByVal lpszDst As String, ByVal cchDstLength As Long) As Long
Declare Function OemToCharBuff Lib "user32" Alias "OemToCharBuffA" _
   (ByVal lpszSrc As String, ByVal lpszDst As String, ByVal cchDstLength As Long) As Long

выбирай...

Автор: quasi 15.11.2007, 10:51
Код

Dim l_lReturn as Long
Dim l_sSource as String 'исходный текст
Dim l_sDestination as String 'возвращаемый текст
l_lReturn = oemtochar(l_sSource, l_sDestination)

А как забирать текст из исходного файла и сохранять в файл назначения с тем же форматом в виндовой кодировке?

Автор: bom 16.11.2007, 00:16
Есть в VB такие функции как: input, print..., вот с их помощью и забирай.

Автор: quasi 16.11.2007, 02:11
Как передать значение из f.ReadAll  в  l_sSource?
Код

Dim l_lReturn as Long 
Dim l_sSource as String 'исходный текст 
Dim l_sDestination as String 'возвращаемый текст 
l_lReturn = oemtochar(l_sSource, l_sDestination) 

Код

Const ForReading = 1, ForWriting = 2
   Dim fso, f 
   Set fso = CreateObject("Scripting.FileSystemObject") 
   Set f = fso.OpenTextFile("c:\testfile.txt", ForReading) 
   ReadAllTextFile =   f.ReadAll 
   f.close

Можно ли читать и писать один файл, как?

Автор: Akina 16.11.2007, 09:26
Цитата(quasi @  16.11.2007,  03:11 Найти цитируемый пост)
Можно ли читать и писать один файл

Нежелательно. Может привести к конфликтам.

Автор: JusTalionis 17.11.2007, 10:34
Технически - в данном случае можно, поскольку перекодировка байт-на-байт, и конфликта получиться не должно бы.
НО!
В таком исполнении исходный вариант сразу пропадает навсегда, что не есть гуд! А если Вы по ошибке запустили преобразование по тому файлу, который не надо было? - капут!..
Неет, исходник сохранять надо!
Я бы рекомендовал, как обычно, задать сначала переименование исходного файла в .bak или .old (или что там больше Вам подходит по смыслу), и затем с него писать преобразованный файл под начальным именем.

Автор: quasi 19.11.2007, 02:10
Что тут не так?
Код

Dim l_lReturn as Long, l_sSource as String, l_sDestination as String
  Const ForReading = 1, ForWriting = 2 
   Dim fso, f 
   Set fso = CreateObject("Scripting.FileSystemObject") 
   Set f = fso.OpenTextFile("c:\print.txt", ForReading) 
   l_sSource =   f.ReadAll 
f.close 
   l_lReturn = oemtochar(l_sSource, l_sDestination) 
   Set f = fso.OpenTextFile("c:\print.txt", ForWriting, True) 
   f.write l_lReturn
'   l_sDestination = f.Write 
f.close

Автор: Akina 19.11.2007, 09:32
Цитата(quasi @  19.11.2007,  03:10 Найти цитируемый пост)
Что тут не так?

Пространство под l_sDestination должно быть зарезервировано ДО вызова API-функции:

7.5: l_sDestination = Space(Len(l_sSource))

Автор: bom 19.11.2007, 14:45
... Ну и естественно записывать в файл не число вернутое функцией, а подготовленный строковый буфер. В остальном copy\paste сработало без ошибок.

Автор: quasi 20.11.2007, 10:10
Цитата

записывать в файл не число вернутое функцией, а подготовленный строковый буфер. 

Можно подробнее? smile 

Автор: Akina 20.11.2007, 10:21
10: f.write l_sDestination 

PS. Еще один вопрос без мыслей в голове - и остаток темы будете прорабатывать в Центре помощи.

Автор: quasi 2.12.2007, 11:00
Ткните что не так?!
Код
Dim l_lReturn, l_sSource, l_sDestination, fso, f
Function oemtochar(s)
Dim i,k
  For i=1 To Len(s) 
    k = Asc(Mid(s,i,1))  
    If (128 <= k) And (k <= 175) Then
      k=k+64
    ElseIf (224 <= k) And (k <= 239) Then
      k=k+16
    ElseIf k = 240 Then
      k=168
    ElseIf k = 241 Then
      k=184
    End If
    l_sSource=l_sSource+Chr(k) 
  Next
oemtochar=l_sSource
End Function
Const ForReading = 1, ForWriting = 2
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set f = fso.OpenTextFile("c:\print.txt", ForReading)
   l_sSource =   f.ReadAll
f.close
   l_sDestination = Space(Len(l_sSource))
   l_lReturn = oemtochar(l_sSource, l_sDestination)
   Set f = fso.OpenTextFile("c:\print.txt", ForWriting, True)
   f.write l_sDestination
f.close

Автор: bom 2.12.2007, 12:14
Держи. На следующий раз - готовь VMZ smile 
Код

Private Declare Function OemToChar Lib "user32" Alias "OemToCharA" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long

Private Sub Form_Load()
Dim str_buff As String
Open "c:\print.txt" For Binary As #1
str_buff = Space(LOF(1))
Get #1, 1, str_buff
OemToChar str_buff, str_buff
Put #1, 1, str_buff
Close #1
End Sub

Автор: quasi 3.12.2007, 02:20
bom, спасибо, но ваш примеркик на VB, а нужно на VBS. ВОт только не пойму, получается пустышка, даже не ругается что таких файлов print1.txt и print2.txt нет, хм...
Код

Dim l_lReturn, l_sSource, l_sDestination, fso, f 
Function oemtochar(s) 
Dim i,k
  For i=1 To Len(s) 
    k = Asc(Mid(s,i,1))  
    If (128 <= k) And (k <= 175) Then 
      k=k+64 
    ElseIf (224 <= k) And (k <= 239) Then 
      k=k+16 
    ElseIf k = 240 Then 
      k=168 
    ElseIf k = 241 Then 
      k=184 
    End If 
    l_sSource=l_sSource+Chr(k) 
  Next 
oemtochar=l_sSource 
Const ForReading = 1, ForWriting = 2 
   Set fso = CreateObject("Scripting.FileSystemObject") 
   Set f = fso.OpenTextFile("c:\print2.txt", ForReading) 
   l_sSource =   f.ReadAll 
f.close 
   l_sDestination = Space(Len(l_sSource)) 
   l_lReturn = oemtochar(l_sSource, l_sDestination) 
   Set f = fso.OpenTextFile("c:\print1.txt", ForWriting, True) 
   f.write l_sDestination 
f.close
End Function 

Автор: bom 3.12.2007, 09:50
Получите:
Код

Function oemtochar(s) 
  For i=1 To Len(s) 
    k = Asc(Mid(s,i,1))  
    If (128 <= k) And (k <= 175) Then 
      k=k+64 
    ElseIf (224 <= k) And (k <= 239) Then 
      k=k+16 
    ElseIf k = 240 Then 
      k=168 
    ElseIf k = 241 Then 
      k=184 
    End If 
    oemtochar=oemtochar+Chr(k) 
  Next 
End Function 

Set fso = CreateObject("Scripting.FileSystemObject") 
fso.OpenTextFile("c:\print1.txt", 2, True).write oemtochar(fso.OpenTextFile("c:\print2.txt", 1).ReadAll)

Автор: Akina 3.12.2007, 11:40
Надоело. Переношу.

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)