using chrw to binary convert a long integer to a string

Question

I'm experimenting with bitmaps in VBScript, writing them to file and opening them with the default application. See https://github.com/antonig/vbs/tree/master/VBScript_graphics The slowest part is in writing the pixels from an array to a byte string then to the file. I'm presently using this classic snippet to convert long values to 4 byte strings:

function long2str(byval k)
        Dim s
        for i=1 to 4
            s= chr(k and &hff)
            k=k\&h100
        next
End function

I wondered if I could make the conversion faster using just two chrw() in the place of the four chr(). To my dismay i learned chrw takes a signed short integer. Why so??. So the code has to deal with the highest bits separately. This is what I tried but it does'nt work:

function long2wstr(byval x)
  dim k,s
    k=((x and &h7fff) or (&H8000 * ((x and &h8000) <>0 )))
  s=chrw(k)
  k=((x and &h7fff0000)\&h10000 or(&H8000 * (x<0)))
    s=s & chrw(k)
  long2wstr=s
end function 

'test code
for i=0 to &hffffff
  x=long2wstr(i)
  y=ascw(mid(x,1,1))+&h10000*ascw(mid(x,2,1))
  if i<>y then wscript.echo hex(i),hex(y)
next
wscript.echo "ok"  'if the conversion is correct the program should print only ok 

Can you help me?

Answer 1

Today I can answer my own question. To write binary data to a file two bytes at a time is possible. The bad news is the increase of speed is just marginal. Here is a demo code, the solution was about adding some & suffixes to the hex values in my original code.

fn=CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2)& "\testwchr.bmp"

Function long2wstr( x)  'falta muy poco!!!
  Dim k1,k2,x1
  k1=((x And &h7fff) Or (&H8000& And ((X And &h8000&)<>0)))
  
  k2=((X And &h7fffffff&) \ &h10000&) Or (&H8000& And ((X And &h80000000&) <>0 ))
  long2wstr=chrw(k1) & chrw(k2)
End Function


Function wstr2long(s)
  x1=AscW(mid(s,1,1))
  xx1=x1-(65536 *(x1<0))
  x2=AscW(mid(s,2,1))
  wstr2long=x2*65536+xx1 
End Function 

Function rndlong() rndlong=CLng(4294967296* rnd()-2147483648+256*rnd) :End Function
  
  Dim a(1000)
  With  CreateObject("ADODB.Stream") 
    .Charset = "UTF-16LE"    'o "UTF16-BE" 
    .Type =  2' adTypeText  
    .open 
    Randomize timer
    For I=0 To 1000
      a(i)=rndlong
      .writetext long2wstr(a(i))
    Next
    .savetofile fn,2 
    .close
    
    'now read the file to see if ADODB has changed anything
    .open
    .loadfromfile fn
    .position=2   'skip bom
     cnt=0
    For I=0 To 1000
       j= wstr2long(.readtext (2))
      If j<>a(i) Then WScript.Echo a(i),j:cnt=cnt+1
    Next
    WScript.Echo cnt  'should print 0
    .close
  End With