VB Forum / General 2 / May 2004

1) Find out what Unicode Characters really are
2) Look at StrConv() in the help files (others have told you this)
   Play with Byte Arrays and Strings
3) Look in Help Files for the:  Open Statement

Frankly, I would write a few simple things that store and read ANSII
- then delve into Unicode

At risk of being rather brusque, if you cannot learn how to explore
the help files and experiment, then you will be restricted to using VB
as a 'user' rather than a programmer

Show some signs of making an effort and you will get plenty of help.

Here is a simple demo
- I suggest you choose a different font to fully test it.
- also look at what is really written in the file
( I can help you there with a very old utility )

Option Explicit

' Add two Command Buttons
' Add one Textbox
' Add one Label

Const Fle$ = "c:\test.dat"

Private Sub Form_Load()
  Command1.Caption = "Save Text"
  Command2.Caption = "Load Text"
  ' --- Select a Unicode Font
  Me.Font.Name = "Wingding"
  '
  Set Text1.Font = Me.Font
  Set Label1.Font = Me.Font
  '
  Label1.Caption = ""
  Text1.Text = "This is Text" + ChrW$(352)
End Sub

' --- Write some Unicode
Private Sub Command1_Click()
  Dim B() As Byte
  Dim S As String
  Dim Channel As Integer
 
  Channel = FreeFile
  S = Text1.Text
  B() = S ' Take Unicode String
  Open Fle$ For Binary As #Channel
  Seek #Channel, 1  ' not needed
  Put #Channel, , B()
  Close #Channel
End Sub

' --- Read some Unicode
Private Sub Command2_Click()
  Dim B() As Byte
  Dim S As String
  Dim Channel As Integer
  Dim L As Long
 
  Channel = FreeFile
  L = FileLen(Fle$)
  ReDim B(0 To L - 1)
  Open Fle$ For Binary As #Channel
  Seek #Channel, 1  ' not needed
  Get #Channel, , B()
  Close #Channel
 
  S = B()
  Label1.Caption = S
End Sub

Here's some easy to use approach, to implement your own filebased
Recordset-Class, that should work with Win98 and has Unicode-Support also:
Open a Standard-Exe-Project and add a Class (name it cRsPersons for
example).

'****Into the Form:
Option Explicit

Private Persons As CRsPersons

Private Sub Form_Load()
Dim i&, T#, CC&
 Set Persons = New CRsPersons
 Persons.BindTo "c:\Persons.dat"
 CC = Persons.RecordCount
 MsgBox "File contains " & CC & " Records."

 If CC Then
   MsgBox "First RecordID = " & Persons.ID & ", " & Persons.Name
   Persons.AbsolutePosition = Persons.RecordCount \ 2
   MsgBox "Mid RecordID = " & Persons.ID & ", " & Persons.Name
   Persons.MoveLast
   MsgBox "Last RecordID = " & Persons.ID & ", " & Persons.Name

   T = Timer 'Fast delete of all records (from last to first)
   Persons.MoveLast
   Do
     Persons.Delete
     Persons.MovePrevious
   Loop Until Persons.BOF
   MsgBox CC & " Records deleted after " & Timer - T & " sec"
 End If

 T = Timer
 With Persons
   For i = 1 To 10000
     .AddNew
     .ID = i: .Name = "Name" & i: .BirthDay = Now
     .Update
   Next i
   MsgBox .RecordCount & " Records added in " & Timer - T & " sec"
 End With
End Sub

'****Into the Class cRsPersons (the main-part of this class is generic):
Option Explicit

Private Type Tbl 'look at this Type as your TableDef
 Deleted As Boolean 'set always this first member (for internal use)
 ID As Long
 Name As String * 64 'always use FixedLength Strings
 BirthDay As Date
 '+ additional fields at will - make sure, that all Members that'll be
 'defined here (excepting the Deleted-Member), get their correct
 'Property-Implementation at the end of this class
End Type

'***********Default CodeBlock - Don't change it************
Private Declare Sub RtlMoveMemory Lib "kernel32" _
 (Dst As Any, Src As Any, ByVal BCount&)
Private FNr&, RLen&, ii&, Idx&(), Records() As Tbl, RC&, B() As Byte, W0$
Public Sub BindTo(FName$)
Dim i&, FLen&, Record As Tbl
 If FNr Then Close FNr
 FNr = FreeFile: Open FName For Binary As FNr
 RLen = LenB(Record): FLen = LOF(FNr)
 RC = FLen \ RLen: FLen = RC * RLen: W0 = ChrW(0)
 ReDim Records(-1 To RC + 256): ReDim Idx(-1 To RC + 256)
 If RC = 0 Then ii = -3: ReDim B(RLen - 1): Exit Sub
 ReDim B(RC * RLen - 1): Get FNr, 1, B
 RtlMoveMemory Records(0).Deleted, B(0), RC * RLen
 RC = 0: ReDim B(RLen - 1)
 For i = 0 To FLen \ RLen - 1
   If Not Records(i).Deleted Then Idx(RC) = i: RC = RC + 1
 Next i
 If RC = 0 Then ii = -3 Else ii = 0
End Sub
Public Function BOF(): BOF = (ii = -1) Or (ii = -3): End Function
Public Function EOF(): EOF = (ii = -2) Or (ii = -3): End Function
Public Function RecordCount&(): RecordCount = RC: End Function
Public Property Get AbsolutePosition&()
 If ii < 0 Then Exit Property Else AbsolutePosition = ii + 1
End Property
Public Property Let AbsolutePosition(ByVal P&)
 If P <= 0 Or P > RC Then Exit Property Else ii = P - 1
End Property
Public Sub MoveFirst()
 If RC Then ii = 0
End Sub
Public Sub MoveLast()
 If RC Then ii = RC - 1
End Sub
Public Sub MovePrevious()
 If BOF Then Exit Sub Else ii = ii - 1: If ii < 0 Then ii = RC - 1
End Sub
Public Sub MoveNext()
 If EOF Then Exit Sub Else ii = ii + 1: If ii = RC Then ii = -2
End Sub
Public Sub Delete()
Dim i&: If ii < 0 Then Exit Sub
 Records(Idx(ii)).Deleted = True: Update: RC = RC - 1
 For i = ii To RC - 1: Idx(i) = Idx(i + 1): Next
 If ii = RC Then ii = -2
End Sub
Public Sub AddNew()
 ii = RC: Idx(ii) = IIf(RC > 0, Idx(ii - 1) + 1, 0): RC = RC + 1
 Records(Idx(ii)) = Records(-1) 'set NewRecord=EmptyRecord
 If Idx(ii) < UBound(Idx) Then Exit Sub
 ReDim Preserve Records(-1 To Idx(ii) * 2)
 ReDim Preserve Idx(-1 To Idx(ii) * 2)
End Sub
Public Sub Update()
If ii < 0 Then Exit Sub
 RtlMoveMemory B(0), Records(Idx(ii)).Deleted, RLen
 Put FNr, Idx(ii) * RLen + 1, B
End Sub
Private Function GetStr$(S$) 'Unicode-String from Tbl-StringMember
 GetStr = LeftB$(S, (LenB(S) - 1 + InStrB(S, W0)) Mod LenB(S) + 1)
End Function
Private Sub Class_Terminate()
 If FNr Then Close FNr
End Sub
'******************End Default-Codeblock********************

'<<<<<<<<<<<<<Tbl-Implementation starts here>>>>>>>>>>>>>>>>
'this class implements the ID, Name and Brithday-Members of the Tbl-
'Type defined on Top of this class; no implementation is needed for
'the Deleted-Field, wich always should be the first member in a TblDef
'take care for the correct field-names inside every property-pair
'you can easily implement additional validation for every Record-
'Field, if you check the appropriate V-Value inside every Property Let
Public Property Get ID(): If ii < 0 Then Exit Property
 ID = Records(Idx(ii)).ID
End Property
Public Property Let ID(V): If ii < 0 Then Exit Property
 Records(Idx(ii)).ID = V
End Property

Public Property Get Name(): If ii < 0 Then Exit Property
 Name = GetStr(Records(Idx(ii)).Name)
End Property
Public Property Let Name(V): If ii < 0 Then Exit Property
 Records(Idx(ii)).Name = V & W0 '<< allways add W0 to str-members
End Property

Public Property Get BirthDay(): If ii < 0 Then Exit Property
 BirthDay = Records(Idx(ii)).BirthDay
End Property
Public Property Let BirthDay(V): If ii < 0 Then Exit Property
 Records(Idx(ii)).BirthDay = V
End Property

Olaf