使用chrw将长整数二进制转换为字符串

Question

我正在 VBScript 中试验位图，将它们写入文件并使用默认应用程序打开它们。请参阅https://github.com/antonig/vbs/tree/master/VBScript_graphics 最慢的部分是将像素从数组写入字节字符串，然后写入文件。我目前正在使用这个经典片段将长值转换为 4 字节字符串：

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

我想知道是否可以仅使用两个 chrw() 代替四个 chr() 来加快转换速度。令我沮丧的是，我了解到 chrw 需要一个 signed 短整数。为什么这样？？。因此代码必须单独处理最高位。这是我尝试过的，但它不起作用：

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 

你能帮我吗？

Answer 1

今天我可以回答我自己的问题了。可以一次将两个字节的二进制数据写入文件。坏消息是速度的提高只是微不足道的。这是一个演示代码，解决方案是在我的原始代码中的十六进制值中添加一些 & 后缀。

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