10-06-2011، 10:59 AM
Binary Put/Get for Strings (with Unicode)
English:
نقل قول:More information: These functions allow you to write and read (put/get) strings to/from a file opened in binary-mode. A unicode-version is also included. All functions let you specify if you want to use a integer or long length-descriptor. If you choose integer the resulting file will be 2 bytes shorter than choosing long, but the string can only be 2^15-1 Bytes long.Persian:
نقل قول:با تابع put میتونید در فایل بنویسید و با تابع get میتونید از فایل بخونید !
البته تو این روش یونیکد هم ساپورت میکنه به قول نویسنده کد
کد:
'www.parsicoders.cim
Function GetString(ByVal Filenumber As Integer, _
ByVal Lng As Boolean) As String
Dim StrLengthLng As Long
Dim StrLengthInt As Integer
Dim StrLength As Long
If Lng Then
Get #Filenumber, , StrLengthLng
StrLength = StrLengthLng
Else
Get #Filenumber, , StrLengthInt
StrLength = StrLengthInt
End If
GetString = String$(StrLength, " ")
Get #Filenumber, , GetString
End Function
Sub PutString(ByVal Filenumber As Integer, Strng As String, _
ByVal Lng As Boolean)
If Lng Then
Put #Filenumber, , CLng(Len(Strng))
Else
Put #Filenumber, , CInt(Len(Strng))
End If
Put #Filenumber, , Strng
End Sub
Function GetStringU(ByVal Filenumber As Integer, _
ByVal Lng As Boolean) As String
Dim StrLengthLng As Long
Dim StrLengthInt As Integer
Dim StrLength As Long
If Lng Then
Get #Filenumber, , StrLengthLng
StrLength = StrLengthLng
Else
Get #Filenumber, , StrLengthInt
StrLength = StrLengthInt
End If
If StrLength = 0 Then
GetStringU = ""
Else
ReDim rwert(StrLength * 2 - 1) As Byte
Get #Filenumber, , rwert
GetStringU = rwert
End If
End Function
Sub PutStringU(ByVal Filenumber As Integer, _
Strng As String, ByVal Lng As Boolean)
If Lng Then
Put #Filenumber, , CLng(Len(Strng))
Else
Put #Filenumber, , CInt(Len(Strng))
End If
Dim b() As Byte
b = Strng
Put #Filenumber, , b
End Sub