Anyway, now the football is out of the way, I tried this unicode stuff with the C runtime
Qriginal request:
Code: Select all
#include "crt.bi"
#include "file.bi"
function _Remove(byval Text As String,Char As String) as string
Var index = 0,asci=Asc(char)
For i As Integer = 0 To Len(Text) - 1
If Text[i] <> ASCi Then Text[index] = Text[i] : index =index+ 1
Next
return Left(Text,index)
End function
Sub save overload (filename As wString,p As String)
dim as wstring * 10 tempname="VT.txt"
Dim As Integer n
n=Freefile
If Open (tempname For Binary Access Write As #n)=0 Then
Put #n,,p
Close
Else
Print "Unable to save " + filename
End If
if len(filename) then
_wrename(@tempname,@filename)
else
print "Filename error"
end if
if fileexists(tempname) then kill tempname
End Sub
sub save overload(filename as wstring,content as wstring)
dim as wstring * 10 tempname="VT.txt"
Dim As Long n=Freefile
Open tempname For Output Encoding "utf16" As #n
Print #n,content
Close #n
_wrename(@tempname,@filename)
if fileexists(tempname) then kill tempname
end sub
sub load overload(filename as wstring, text as string)
dim as wstring * 10 tempname="VT.txt"
_wrename(@filename,@tempname)
var f=freefile
Open tempname For Binary Access Read As #f
If Lof(1) > 0 Then
text = String(Lof(f), 0)
Get #f, , text
End If
Close #f
_wrename(@tempname,@filename)
if fileexists(tempname) then kill tempname
end sub
sub load overload(filename as wstring,content as wstring)
dim as wstring * 20 r="rt+,ccs=UNICODE"'"r"
dim as wstring * 1000 t
dim as long flag
dim as file ptr fp = _wfopen(@filename,@r)
if fp=0 then print "Unable to load ";filename:sleep:exit sub
while 1
flag=0
if (fgetws (@t,1000,fp)= 0)then exit while
content+=t+wchr(10)
rtrim(content,wchr(10))
wend
fclose(fp)
end sub
dim as wstring * 15 filename="unic.txt"
dim as wstring * 15 utext="<Kc.txt>"
save(filename,utext)'save wide
dim as string file1
Dim as integer posL, posR
dim as string tmp
load("unic.txt",file1)'load ascii
print "unic.txt:"
print file1
posL=Instr(file1, "<")
posR=Instr(file1, ">")
Print "L=";posL;", Rx=";posR
file1=Mid(file1, posL+1, posR-posL-1)
file1=_remove(file1,chr(0))
print "New filename ";file1
dim as string msg
dim as string binaryfile="Hello World,"+chr(0)+chr(0)+chr(0)+" how are you?" +chr(13,10)
for n as long=1 to 2
if n=2 then msg=" Goodbye " else msg=""
binaryfile+=binaryfile+msg
next n
binaryfile +=" END"
print "---- actual file -----"
print binaryfile
print "----"
save(file1,binaryfile) 'save ascii
dim as string s
load(file1,s) 'load asci
print "loaded from file:"
print s
print "Done press a key"
sleep
dim as wstring * 50 z= " My filename is "+ wchr(&h0414, &h043e, &h0431)
dim as wstring * 50 ret
save(wchr(&h0414, &h043e, &h0431)+".txt",z) 'save wide
load(wchr(&h0414, &h043e, &h0431)+".txt",ret)'loaad wide
print "Content of file with unicode name ";wchr(&h0414, &h043e, &h0431); ret
sleep
kill "Kc.txt"
kill "unic.txt"
Please note i have deleted "unic.txt" (optional)
