|
Листинг - 2
Option Explicit Private Declare Function CharToOem Lib "user32" Alias "CharToOemA" (ByVal lpszSrc _ As String, ByVal lpszDst As String) As Long Private Declare Function OemToChar Lib "user32" Alias "OemToCharA" (ByVal lpszSrc _ As String, ByVal lpszDst As String) As Long Private Declare Function GetACP Lib "kernel32" Alias "GetACP" () As Long Private Declare Function GetOEMCP Lib "kernel32" Alias "GetOEMCP" () As Long Private Sub UserControl_Resize() UserControl.Size Image1.Width, Image1.Height End Sub Public Sub ConvertToDOS(PathStartingFile As String, PathConvertedFile As String) 'файл должен быть не более 32 кб Dim InputStr$, OutputStr$, NewFile$ Dim Code& If Verification = True Then Exit Sub On Error GoTo ErrDOSWin Open PathStartingFile For Input As #1 Do While Not EOF(1) Line Input #1, InputStr OutputStr = Space$(Len(InputStr)) Code = CharToOem(InputStr, OutputStr) NewFile = NewFile & OutputStr & vbCrLf Loop Close #1Dim F% F = FreeFile Open PathConvertedFile For Output As #F Write #F, NewFile Close #F Exit Sub ErrDOSWin: MsgBox "<" & Err.Number & "> - " & Err.Description End Sub Public Sub ConvertToWin(PathStartingFile As String, PathConvertedFile As String) 'файл должен быть не более 32 кб Dim InputStr$, OutputStr$, NewFile$ Dim Code& If Verification = True Then Exit Sub On Error GoTo ErrWinDOS Open PathStartingFile For Input As #1 Do While Not EOF(1) Line Input #1, InputStr OutputStr = Space$(Len(InputStr)) Code = OemToChar(InputStr, OutputStr) NewFile = NewFile & OutputStr & vbCrLf Loop Close #1 Dim F% F = FreeFile Open PathConvertedFile For Output As #F Write #F, NewFile Close #F Exit Sub ErrWinDOS: MsgBox "<" & Err.Number & "> - " & Err.Description End Sub Private Function Verification() As Boolean Dim OemCP&, AnsiCP& OemCP = GetOEMCP AnsiCP = GetACP If OemCP <> 866 Or AnsiCP <> 1251 Then MsgBox "Несоответствие кодовых таблиц", vbExclamation + vbOKOnly, "Ошибка!" Verification = True Exit Function End If Verification = False End Function Public Sub About() frmAbout.Show vbModal End Sub
|
