PNG filter on save

Form1.frm

Option Explicit

Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function GdiplusStartup Lib "gdiplus" (hToken As Long, pInputBuf As Any, Optional ByVal pOutputBuf As Long = 0) As Long
Private Declare Function GdipLoadImageFromFile Lib "gdiplus" (ByVal lFilenamePtr As Long, hImage As Long) As Long
Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal hImage As Long) As Long

Private Sub Form_Load()
    Dim aInput(0 To 3)  As Long
    
    If GetModuleHandle("gdiplus") = 0 Then
        aInput(0) = 1
        Call GdiplusStartup(0, aInput(0))
    End If
End Sub

Private Sub Form_Click()
    Dim sFileName       As String
    Dim sOutputFile     As String
    Dim hBitmap         As Long
    Dim dblTimer        As Double
    
    On Error GoTo EH
    Screen.MousePointer = vbHourglass
    sFileName = "D:\TEMP\Extra_Large_Transparent_Minion_PNG_Image.png"
    sOutputFile = "D:\TEMP\aaa.png"
    If GdipLoadImageFromFile(StrPtr(sFileName), hBitmap) <> 0 Then
        GoTo QH
    End If
    dblTimer = Timer
    If Not WriteBitmapToPngFile(hBitmap, sOutputFile) Then
        GoTo QH
    End If
    Print FileLen(sFileName) & " vs " & FileLen(sOutputFile) & " for " & Format$(Timer - dblTimer, "0.000") & " sec"
QH:
    On Error Resume Next
    If hBitmap <> 0 Then
        Call GdipDisposeImage(hBitmap)
    End If
    Screen.MousePointer = vbDefault
    Exit Sub
EH:
    Debug.Print "Critical error: " & Err.Description
    Resume QH
End Sub

Module1.bas

Option Explicit

'--- for CryptStringToBinary
Private Const CRYPT_STRING_BASE64           As Long = 1
'--- for VirtualProtect
Private Const PAGE_EXECUTE_READWRITE        As Long = &H40
Private Const MEM_COMMIT                    As Long = &H1000
'--- for GdipBitmapLockBits
Private Const PixelFormat32bppARGB          As Long = &H26200A
Private Const PixelFormat24bppRGB           As Long = &H21808
Private Const PixelFormatAlpha              As Long = &H40000
'--- for SHCreateStreamOnFile
Private Const STGM_WRITE                    As Long = 1
Private Const STGM_CREATE                   As Long = &H1000

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function CryptStringToBinary Lib "crypt32" Alias "CryptStringToBinaryA" (ByVal pszString As String, ByVal cchString As Long, ByVal dwFlags As Long, ByVal pbBinary As Long, ByRef pcbBinary As Long, ByRef pdwSkip As Long, ByRef pdwFlags As Long) As Long
Private Declare Function VirtualAlloc Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualProtect Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flNewProtect As Long, ByRef lpflOldProtect As Long) As Long
Private Declare Function DWordParts Lib "msvbvm60" Alias "VarPtr" (ByVal dwValue As Long) As DWordPartsType
Private Declare Function SHCreateStreamOnFile Lib "shlwapi" Alias "SHCreateStreamOnFileW" (ByVal pszFile As Long, ByVal grfMode As Long, ppstm As IUnknown) As Long
Private Declare Function SHCreateMemStream Lib "shlwapi" Alias "#12" (ByVal pInit As Long, ByVal cbInit As Long) As IUnknown
'--- GDI+
Private Declare Function GdipBitmapLockBits Lib "gdiplus" (ByVal hBitmap As Long, uRect As Any, ByVal lFlags As Long, ByVal lPixelFormat As Long, uLockedBitmapData As APIBITMAPDATA) As Long
Private Declare Function GdipBitmapUnlockBits Lib "gdiplus" (ByVal hBitmap As Long, uLockedBitmapData As APIBITMAPDATA) As Long
Private Declare Function GdipGetImagePixelFormat Lib "gdiplus" (ByVal Image As Long, nFormat As Long) As Long

Private Type APIBITMAPDATA
    Width               As Long
    Height              As Long
    Stride              As Long
    PixelFormat         As Long
    Scan0               As Long
    Reserved            As Long
End Type

Private Type DWordPartsType
    Byte0               As Byte
    Byte1               As Byte
    Byte2               As Byte
    Byte3               As Byte
End Type

Private Sub pvPatchThunk(ByVal pfn As Long, sThunkStr As String)
    Dim lThunkSize      As Long
    Dim lThunkPtr       As Long
    Dim bInIDE          As Boolean

    '--- decode thunk
    Call CryptStringToBinary(sThunkStr, Len(sThunkStr), CRYPT_STRING_BASE64, 0, lThunkSize, 0, 0)
    lThunkPtr = VirtualAlloc(0, lThunkSize, MEM_COMMIT, PAGE_EXECUTE_READWRITE)
    Call CryptStringToBinary(sThunkStr, Len(sThunkStr), CRYPT_STRING_BASE64, lThunkPtr, lThunkSize, 0, 0)
    '--- patch func
    Debug.Assert pvSetTrue(bInIDE)
    If bInIDE Then
        Call CopyMemory(pfn, ByVal pfn + &H16, 4)
    Else
        Call VirtualProtect(pfn, 8, PAGE_EXECUTE_READWRITE, 0)
    End If
    ' B8 00 00 00 00       mov         eax,00000000h
    ' FF E0                jmp         eax
    Call CopyMemory(ByVal pfn, 6333077358968.8504@, 8)
    Call CopyMemory(ByVal (pfn Xor &H80000000) + 1 Xor &H80000000, lThunkPtr, 4)
End Sub

Private Function pvSetTrue(bValue As Boolean) As Boolean
    bValue = True
    pvSetTrue = True
End Function

Public Sub EncodePngLine(ByVal lPixelsPtr As Long, ByVal lStrideBytes As Long, ByVal lWidth As Long, ByVal lHeight As Long, ByVal lY As Long, ByVal lN As Long, ByVal lFilterType As Long, ByVal lLineBufferPtr As Long, Optional ByVal fSwapRebBlue As Long, Optional ByVal lProbBufferPtr As Long, Optional sngEntropy As Single)
    Const STR_THUNK     As String = "VYvsg+wwi00YjVXkx0XkAAAAAMdF6AEAAADHRewCAAAAx0XwAwAAAMdF9AQAAADHRdAAAAAAx0XUAQAAAMdF2AAAAADHRdwFAAAAx0XgBgAAAIXJdQONVdCLRSBTi10cVot1DIsUgotFEA+v8VeJVfwDdQiDfSgAiXUIdDOLyA+vy4XJfiq4/v///41+AivGi9GL8IoHik/+iEf+iA8D+40ENzvCfO2LdQiLVfyLRRCF0nUvi30ki9APr9OLz4XSD4SlAQAAK/frBo2bAAAAAIoEMY1JAYhB/4PqAXXy6YgBAACF2w+OrgAAAIt9JIvOK00Mi8OJTQiLzotdCCvPiU0giUUYg/oBdHaD+gJ1B4oEDyoD622D+gN1EYtFIIoL0OmKBAcqwYtNIOtXg/oEdUUPtgOJRQgzwJmLyItFCDPKK8qZM8IrwjvIfBKLRSAyyYtV/IoEByrBi00g6yWLRSAPn8GLVfz+ySJNCIoEByrBi00g6w2D+gV0BYP6BnUIigQPiAeLRRhDR4PoAYlFGA+Fb////4tdHIP6AXVAi0UQi9OLfSQPr8OJRQw72A+NtwAAAIvGK8OLXQyJRRgr940MOot9GIoEMSoEF0KLfSSIATvTfOqLXRzpjQAAAIP6AnU6i0UQi9OLfSQPr8OJRRg72H12i10Yi8YrRQwr94lFDI0MOot9DIoEMSoEF0KLfSSIATvTfOqLXRzrToP6Aw+FoQAAAItVEA+v0zvafTiLRSQDw4lFHIvDK0UMK9OL" & _
                                    "fRyJRQwPtgwwjXYBD7ZG/41/AQPIikQe/9HpKsGIR/+LRQyD6gF13Yt9JItNLIXJD4T1AQAAi3UQM9IPr/OF9n4MD7YEOkL/BIE71nz0M8Az0jPbAxyBA1SBBIPAAj0AAQAAfO+LdTAD2tnuM9KJXSTZFttFJNldENlFENldENlFEOlgAQAAg/oED4WtAAAAi0UQD6/DO9h9jotNJIvWK1UMi/srfQwDyyvDiX0IiU0gi/iJVRiJRRyNpCQAAAAAD7YCi00ID7YWiUUMiVX4D7YMDolNHIvKK8gDTRyLwSvCmTPCK8KJRfyLwStFHCtNDJkzwivCiUUoi8GLTSiZM8IrwotV/DvRfwk70H8Fi0346wo7yIpNHH4Dik0MigQeRotVGCrBi00gQolVGIgBQYlNIIPvAXWI6ev+//+D+gV1QItFEIt9JA+vw4ldDIlFGDvYD43S/v//i8Yrwyv3iUUgigwYjRQ7igQyQ9DpKsGIAotFIDtdGHzoi10c6an+//+D+gYPhZ3+//+LRRCLfSQPr8OJXQyJRSA72A+Nif7//zPAmTPCK8KJRRiLxivDK/eJRQgPtgwYi8GZM8IrwjlFGA+fwv7KItGNDDuKBDFDKsKIAYtFCDtdIHzYi10c6Ub+///ZydsEkdldHNlFHNjx2V0k2cnYVSTf4PbEBXod3djd2NlFJNlFJNnx2V0k2QbYZSTZHtnu2UUQ2clCgfoAAQAAfL7d2N3YX15bi+VdwiwAzMzMzA=="  ' 24.3.2019 11:57:48

    pvPatchThunk AddressOf Module1.EncodePngLine, STR_THUNK
    EncodePngLine lPixelsPtr, lStrideBytes, lWidth, lHeight, lY, lN, lFilterType, lLineBufferPtr, fSwapRebBlue, lProbBufferPtr, sngEntropy
End Sub

Private Sub pvPatchMethodProto(ByVal pfn As Long, ByVal lMethodIdx As Long)
    Dim bInIDE          As Boolean
    
    Debug.Assert pvSetTrue(bInIDE)
    If bInIDE Then
        '--- note: IDE is not large-address aware
        Call CopyMemory(pfn, ByVal pfn + &H16, 4)
    Else
        Call VirtualProtect(pfn, 12, PAGE_EXECUTE_READWRITE, 0)
    End If
    ' 0: 8B 44 24 04          mov         eax,dword ptr [esp+4]
    ' 4: 8B 00                mov         eax,dword ptr [eax]
    ' 6: FF A0 00 00 00 00    jmp         dword ptr [eax+lMethodIdx*4]
    Call CopyMemory(ByVal pfn, -684575231150992.4725@, 8)
    Call CopyMemory(ByVal (pfn Xor &H80000000) + 8 Xor &H80000000, lMethodIdx * 4, 4)
End Sub
 
Private Function StreamWrite(ByVal pStream As IUnknown, ByVal lPtr As Long, ByVal lSize As Long, Optional lWritten As Long) As Long
    Const IDX_STEAM_WRITE As Long = 4
    pvPatchMethodProto AddressOf Module1.StreamWrite, IDX_STEAM_WRITE
    StreamWrite = StreamWrite(pStream, lPtr, lSize, lWritten)
End Function

Private Function ToBigEndian(ByVal lValue As Long) As Long
    Dim uRet        As DWordPartsType
    
    With DWordParts(lValue)
        uRet.Byte3 = .Byte0
        uRet.Byte2 = .Byte1
        uRet.Byte1 = .Byte2
        uRet.Byte0 = .Byte3
    End With
    Call CopyMemory(ToBigEndian, uRet, 4)
End Function

Private Sub OutputArray(baBuffer() As Byte, pStream As IUnknown)
    Dim hr              As Long
    
    If pStream Is Nothing Then
        Err.Raise 91 ' Object variable or With block variable not set
    End If
    hr = StreamWrite(pStream, VarPtr(baBuffer(0)), UBound(baBuffer) + 1)
    If hr < 0 Then
        Err.Raise hr
    End If
End Sub

Private Sub OutputDWord(ByVal lValue, pStream As IUnknown)
    Dim hr              As Long
    
    If pStream Is Nothing Then
        Err.Raise 91 ' Object variable or With block variable not set
    End If
    hr = StreamWrite(pStream, VarPtr(ToBigEndian(lValue)), 4)
    If hr < 0 Then
        Err.Raise hr
    End If
End Sub

Public Function WritePngToStream(ByVal lPixelsPtr As Long, ByVal lStrideBytes As Long, ByVal lWidth As Long, ByVal lHeight As Long, ByVal lN As Long, pOutput As IUnknown) As Long
    Const NUM_FILTERS   As Long = 5
    Dim lY              As Long
    Dim lIdx            As Long
    Dim baFilt()        As Byte
    Dim baLineBuffer()  As Byte
    Dim laProbBuffer()  As Long
    Dim baZip()         As Byte
    Dim baOutput()      As Byte
    Dim lCrc32          As Long
    Dim lFilterType     As Long
    Dim sngEst          As Single
    Dim sngBest         As Single
    
    On Error GoTo EH
    If pOutput Is Nothing Then
        Set pOutput = SHCreateMemStream(0, 0)
    End If
    ReDim baFilt(0 To (lWidth * lN + 1) * lHeight - 1) As Byte
    ReDim baLineBuffer(0 To lWidth * lN * NUM_FILTERS - 1) As Byte
    For lY = 0 To lHeight - 1
        ReDim laProbBuffer(0 To 256 * NUM_FILTERS - 1) As Long
        EncodePngLine lPixelsPtr, lStrideBytes, lWidth, lHeight, lY, lN, lIdx, VarPtr(baLineBuffer(0)), 1, VarPtr(laProbBuffer(0)), sngBest
        lFilterType = 0
        For lIdx = 1 To NUM_FILTERS - 1
            EncodePngLine lPixelsPtr, lStrideBytes, lWidth, lHeight, lY, lN, lIdx, VarPtr(baLineBuffer(lWidth * lN * lIdx)), 0, VarPtr(laProbBuffer(256 * lIdx)), sngEst
            If sngBest > sngEst Then
                sngBest = sngEst
                lFilterType = lIdx
            End If
        Next
        baFilt((lWidth * lN + 1) * lY) = lFilterType
        Call CopyMemory(baFilt((lWidth * lN + 1) * lY + 1), baLineBuffer(lWidth * lN * lFilterType), lWidth * lN)
    Next
    Erase baLineBuffer
    Erase laProbBuffer
    With New cZipArchive
        .Deflate baFilt, baZip, 8
        Erase baFilt
        ReDim baOutput(0 To 7) As Byte
        Call CopyMemory(baOutput(0), &H474E5089, 4)         '--- "‰PNG\r\n\x1A\n" signature
        Call CopyMemory(baOutput(4), &HA1A0A0D, 4)
        OutputArray baOutput, pOutput
        '--- IHDR
        ReDim baOutput(0 To 16) As Byte
        Call CopyMemory(baOutput(0), &H52444849, 4)         '--- tag "IHDR"
        Call CopyMemory(baOutput(4), ToBigEndian(lWidth), 4)
        Call CopyMemory(baOutput(8), ToBigEndian(lHeight), 4)
        baOutput(12) = 8
        Call CopyMemory(baOutput(13), CLng(Array(-1, 0, 4, 2, 6)(lN)), 4)
        OutputDWord UBound(baOutput) - 3, pOutput           '--- length w/o tag
        OutputArray baOutput, pOutput
        OutputDWord .CalcCrc32Array(baOutput), pOutput
        '--- IDAT
        ReDim baOutput(0 To 5) As Byte
        Call CopyMemory(baOutput(0), &H54414449, 4)         '--- tag "IDAT"
        baOutput(4) = &H78                                  '--- CMF byte
        baOutput(5) = &H5E                                  '--- FLG byte
        OutputDWord UBound(baOutput) - 3 + UBound(baZip) + 1, pOutput '--- length w/o tag
        OutputArray baOutput, pOutput
        OutputArray baZip, pOutput
        lCrc32 = -1
        .CalcCrc32Ptr VarPtr(baOutput(0)), UBound(baOutput) + 1, lCrc32
        .CalcCrc32Ptr VarPtr(baZip(0)), UBound(baZip) + 1, lCrc32
        OutputDWord lCrc32 Xor -1, pOutput
        '--- IEND
        ReDim baOutput(0 To 3) As Byte
        Call CopyMemory(baOutput(0), &H444E4549, 4)         '--- tag "IEND"
        OutputDWord UBound(baOutput) - 3, pOutput           '--- length w/o tag
        OutputArray baOutput, pOutput
        OutputDWord .CalcCrc32Array(baOutput), pOutput
    End With
    '--- success (return size)
    WritePngToStream = UBound(baZip) + 58
QH:
    Exit Function
EH:
    Debug.Print "Critical error: " & Err.Description
    Resume QH
End Function

Public Function WriteBitmapToPngFile(ByVal hBitmap As Long, sFileName As String) As Boolean
    Dim lPixelFormat    As Long
    Dim uData           As APIBITMAPDATA
    Dim pOutput         As IUnknown
    
    On Error GoTo EH
    If GdipGetImagePixelFormat(hBitmap, lPixelFormat) <> 0 Then
        GoTo QH
    End If
    If GdipBitmapLockBits(hBitmap, ByVal 0, 1, IIf((lPixelFormat And PixelFormatAlpha) <> 0, PixelFormat32bppARGB, PixelFormat24bppRGB), uData) <> 0 Then
        GoTo QH
    End If
    If SHCreateStreamOnFile(StrPtr(sFileName), STGM_WRITE Or STGM_CREATE, pOutput) < 0 Then
        GoTo QH
    End If
    If WritePngToStream(uData.Scan0, uData.Stride, uData.Width, uData.Height, IIf((lPixelFormat And PixelFormatAlpha) <> 0, 4, 3), pOutput) = 0 Then
        GoTo QH
    End If
    '--- success
    WriteBitmapToPngFile = True
QH:
    On Error Resume Next
    If uData.Scan0 <> 0 Then
        Call GdipBitmapUnlockBits(hBitmap, uData)
    End If
    Exit Function
EH:
    Debug.Print "Critical error: " & Err.Description
    Resume QH
End Function

thunk.cpp

#include <stdio.h>
#include <windows.h>

#pragma comment(lib, "crypt32")

#define STBIW_UCHAR(x) (unsigned char) ((x) & 0xff)
#define stbi__flip_vertically_on_write 0

typedef void (__stdcall * pfn_stbiw__encode_png_line)(unsigned char *pixels, int stride_bytes, int width, int height, int y, int n, int filter_type, signed char *line_buffer, int swap_red_blue, int *prob_buffer, float *entropy);

static unsigned char __stdcall stbiw__paeth(int a, int b, int c);
static void * __stdcall my_memcpy(void *d, const void *s, int n);
static int __stdcall my_abs(int a);

static void __stdcall stbiw__encode_png_line(unsigned char *pixels, int stride_bytes, int width, int height, int y, int n, int filter_type, 
                                             signed char *line_buffer, int swap_red_blue, int *prob_buffer, float *entropy)
{
   /*static*/ int mapping[] = { 0,1,2,3,4 };
   /*static*/ int firstmap[] = { 0,1,0,5,6 };
   int *mymap = (y != 0) ? mapping : firstmap;
   int i;
   int type = mymap[filter_type];
   unsigned char *z = pixels + stride_bytes * (stbi__flip_vertically_on_write ? height-1-y : y);
   int signed_stride = stbi__flip_vertically_on_write ? -stride_bytes : stride_bytes;
   int prob_total = 0;

   if (swap_red_blue) {
      for (i=0; i < width*n; i+=n) {
          unsigned char temp = z[i+0];
          z[i+0] = z[i+2];
          z[i+2] = temp;
      }
   }
   if (type==0) {
      my_memcpy(line_buffer, z, width*n);
      goto calc_entropy;
   }

   // first loop isn't optimized since it's just one pixel    
   for (i = 0; i < n; ++i) {
      if (type == 1) {
         line_buffer[i] = z[i];
      }
      else if (type == 2) {
         line_buffer[i] = z[i] - z[i-signed_stride];
      }
      else if (type == 3) {
         line_buffer[i] = z[i] - (z[i-signed_stride]>>1);
      }
      else if (type == 4) {
         line_buffer[i] = (signed char) (z[i] - stbiw__paeth(0,z[i-signed_stride],0));
      }
      else if (type == 5) {
         line_buffer[i] = z[i];
      }
      else if (type == 6) {
         line_buffer[i] = z[i];
      }
   }
   if (type == 1) {
      for (i=n; i < width*n; ++i) line_buffer[i] = z[i] - z[i-n];
   }
   else if (type == 2) {
      for (i=n; i < width*n; ++i) line_buffer[i] = z[i] - z[i-signed_stride];
   }
   else if (type == 3) {
      for (i=n; i < width*n; ++i) line_buffer[i] = z[i] - ((z[i-n] + z[i-signed_stride])>>1);
   }
   else if (type == 4) {
      for (i=n; i < width*n; ++i) line_buffer[i] = z[i] - stbiw__paeth(z[i-n], z[i-signed_stride], z[i-signed_stride-n]);
   }
   else if (type == 5) {
      for (i=n; i < width*n; ++i) line_buffer[i] = z[i] - (z[i-n]>>1);
   }
   else if (type == 6) {
      for (i=n; i < width*n; ++i) line_buffer[i] = z[i] - stbiw__paeth(z[i-n], 0,0);
   }
calc_entropy:
    if (prob_buffer) {
        for (i=0; i < width*n; ++i)
            prob_buffer[((unsigned char *)line_buffer)[i]]++;
        for (i=0; i < 256; ++i)
            prob_total += prob_buffer[i];
        *entropy = 0;
        for (i=0; i < 256; i++) {
            float p = (float)(prob_buffer[i]) / prob_total;
            if (p > 0) {
                _asm {
                    fld p
                    fld p
                    fyl2x
                    fstp p
                }
                *entropy -= p;
            }
        }
    }
}

static unsigned char __stdcall stbiw__paeth(int a, int b, int c)
{
   int p = a + b - c, pa = my_abs(p-a), pb = my_abs(p-b), pc = my_abs(p-c);
   if (pa <= pb && pa <= pc) return STBIW_UCHAR(a);
   if (pb <= pc) return STBIW_UCHAR(b);
   return STBIW_UCHAR(c);
}

static void * __stdcall my_memcpy(void *d, const void *s, int n)
{
    char *dst = (char *)d;
    char *src = (char *)s;
    while(n--)
        *dst++ = *src++;
    return d;
}

static int __stdcall my_abs(int a)
{
    return a < 0 ? -a : a;
}

#define THUNK_SIZE ((char *)main - (char *)stbiw__encode_png_line) - 8

BSTR GetCurrentDateTime();

void main()
{
    CoInitialize(0);
    #define width 500
    #define height 200
    #define n 3
    unsigned char pixels[width * height * n] = { 1,2,3,4,1,2,3,1,2,1 };
    signed char line_buffer[width * n];
    int prob_buffer[256] = { 0 };
    float H;

    void *hThunk = VirtualAlloc(0, 0x10000, MEM_COMMIT, PAGE_EXECUTE_READWRITE);
    printf("hThunk=%p\nTHUNK_SIZE=0x%x\n", hThunk, THUNK_SIZE);
    my_memcpy(hThunk, stbiw__encode_png_line, THUNK_SIZE);
    pfn_stbiw__encode_png_line pfn = (pfn_stbiw__encode_png_line)hThunk;
    for (int filter_type = 0; filter_type < 5; filter_type++) {
        pfn(pixels, n*width, width, height, 0, n, filter_type, line_buffer, 1, prob_buffer, &H);
        printf("filter_type=%d, H=%g\n", filter_type, H);
    }
    WCHAR szBuffer[10000];
    DWORD dwBufSize = _countof(szBuffer);
    CryptBinaryToString((BYTE *)stbiw__encode_png_line, THUNK_SIZE, CRYPT_STRING_BASE64, szBuffer, &dwBufSize);
    for(int i = 0, j = 0; (szBuffer[j] = szBuffer[i]) != 0; ++i) {
        j += (szBuffer[j] != '\r' && szBuffer[j] != '\n');
        if (j % 768 == 0) wcscpy(szBuffer + j, L"\" & _\r\n\""), j += 8;
    }
    printf("Const STR_THUNK     As String = \"%S\" ' %S\n", szBuffer, GetCurrentDateTime());
}

BSTR GetCurrentDateTime()
{
    SYSTEMTIME  st;
    DATE        dt;
    VARIANT     vdt = { VT_DATE, };
    VARIANT     vstr = { VT_EMPTY };

    GetLocalTime(&st);
    SystemTimeToVariantTime(&st, &dt);
    vdt.date = dt;
    VariantChangeType(&vstr, &vdt, 0, VT_BSTR);
    return vstr.bstrVal;
}