Undocument Windows API và VBA

Liên hệ QC
T

ThangCuAnh

Mới rờ Ét xeo
Tham gia
1/12/17
Bài viết
896
Được thích
792
Giới tính
Nam
Nghề nghiệp
Coder nghỉ hưu, RCE dạo
Cái laptop hư lâu lắc, phải gởi vào thành hồ chứa mưa sữa, mới lấy về.
Nên quay lại tiếp với cái gọi là "rờ chxx em" Windows và VBA.
Topic này tui sẽ đăng lần lượt những gì cu anh tui phát hiện ra trong quá trình "rờ em" Windows API, DLLs và VBAxxx.dll. Các tips, tricks này sẽ bảo đảm không có trên ông "Gấu gồ". Và dùng được cho VBA trên Offices. Chứ "ưn đồ cú mèn" API mà chỉ dùng được cho C/C++, Delphi... thì dân tin học VP ở đây thua.
Tui chỉ sẽ tập trung ở các Windows DLL sau: kernel32.dll, shell32.dll, shlwapi.dll, oleaut32.dll, ole32.dll, advapi32.dll... và 1 ít từ ntdll.dll (core usermode API của Windows). Trên VBExxx.dll thì tui chỉ tập trung vào VBE6 của Office 2007, VBE7 của Office2010 32 và 64bit, các VBExxx.dll khác cũng sẽ gần như tương đượng, không khác nhau mấy.
 
Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Đầu tiên, theo thứ tự export từ VBExxx.dll, chúng ta sẽ tìm hiểu về các hàm Space$, Space, Str$ và Str trong VBA
Hàm Space$ = BSTR __stdcall rtcSpaceBstr(int nLen) trong VBExxx.dll
Hàm Space = VARIANTARG *__stdcall rtcSpaceVar(VARIANTARG *v, int nLen) trong VBExxx.dll
Hàm String$ = rtcStringBstr trong VBExxx.dll
Hàm String = rtcStringVar trong VBExxx.dll
 
Lần chỉnh sửa cuối:
Upvote 0
MẠNH đặt 1 vé ghế số 1 hóng Sư Phụ Úp bài ;)
 
Upvote 0
Ăn đốc kiểu mặn tít chứ!
 
Upvote 0
Phiền admin xóa giùm topic này, vì nó nhiều tiểu tiết quá, phải chụp hình, post code, giải thích rất nhiều. Nên thôi. Để dịp khác, nhả tơ từ từ thôi.
Giờ quay lại cho xong cái patch VBExxx.dll đã. Chứ chưa cái nào xong cái nào.
 
Upvote 0
ThangCuAnh đã viết:
Phiền admin xóa giùm topic này, vì nó nhiều tiểu tiết quá, phải chụp hình, post code, giải thích rất nhiều. Nên thôi. Để dịp khác, nhả tơ từ từ thôi.
Giờ quay lại cho xong cái patch VBExxx.dll đã. Chứ chưa cái nào xong cái nào.
Nhấp chuột vào đây để mở rộng...

Em nhờ bác tìm giúp cái hàm TypeName() nhé?
 
Upvote 0
Hôm nay mình tự nhiên bệnh rồi, sáng giờ nhức đầu nóng lạnh. Tối qua nấu nước nóng tắm lại bị phỏng tay nữa chứ. Giờ nó rộp bộng nước lên.
Uhm, VarType với TypeName thì có ngay bạn Tuân à, mà code C API nhé.
 
Upvote 0
Bác Tuân muốn trên 32 hay 64bit ?
Nhờ các bác test giùm cu anh tui file này, xem giới hạn của SysAllocStringLen API trên Windows và máy các bác là bao nhiêu.
Theo lý thuyết, MS document thì trên 32bit là MAX_UINT = 0xFFFFFFFF nhưng hoàn toàn không phải vậy, nhỏ hơn nhiều.
Có 2 sub Test_xxx, các bạn chạy và chịu khó chờ xem ra kết quả bao nhiêu nhé. Máy càng mạnh, càng bộ nhớ nhiều càng tốt.
 

File đính kèm

  • test_rtcVar.xlsm
    14.9 KB · Đọc: 21
Lần chỉnh sửa cuối:
Upvote 0
Cùng 1 code nhưng do compile trên VC++ trên 32bit và 64bit, compiler nó sinh mã khác nhau đôi chút bác. À mà hàm rtcTypeName phức tạp lắm bác Tuân à, dài khủng khiếp. Bác xem chi vậy ?
Hàm VarType của VBA = rtcVarType
Mã: 
int __stdcall rtcVarType(VARIANT *pv)
{
    return (unsigned __int16) GetVarType(pv);
}

__int16 __stdcall GetVarType(VARIANT *pv)
{
    VARTYPE l_vt; // si@3
    LONG lVal; // ecx@4
    int nRet; // edi@7
    int vt; // eax@1
    char excpBuf[32]; // [sp+4h] [bp-30h]@7
    VARIANTARG pvarg; // [sp+24h] [bp-10h]@3

    vt = pv->vt & 0xBFFF;
    if ( vt != VT_DISPATCH )
    {
        return vt;
    }
    if ( pv->vt & VT_BYREF )
    {
        lVal = *pv->plVal;
    }
    else
    {
        lVal = pv->lVal;
    }

    pvarg.vt = 0;
    nRet = ErrObjDefault(lVal, 0, 0, 0, 0, 3, &pvarg, excpBuf);
    EbClearException(excpBuf);
    if ( nRet >= 0 )
    {
        l_vt = pvarg.vt;
        __vbaFreeVar(&pvarg);
        LOWORD(vt) = l_vt;
    }
    else
    {
        LOWORD(vt) = VT_DISPATCH;
    }
    return vt;
}
Bác thấy đấy VarType của VBA cũng như VarType của Delphi, chỉ cần check field vt của VARIANT, nếu VT_DISPATCH thì tùm lum thứ tiếp theo.
Hình như trong Delphi, unit Variants.pas, có hàm VarTypeAsString đó bác Tuân, nó cũng như TypeName (rtcTypeName) của VBA đó.
Bài đã được tự động gộp:

Bà con test giúp mình file ở post #8 nhé.
 
Lần chỉnh sửa cuối:
Upvote 0
Hàm rtcTypeName thì đúng là mình lùng bùng luôn :p
Mã: 
VARIANT *__stdcall rtcTypeName(VARIANT *pVar)
{
    int vt; // edi@1
    int (__stdcall ***v2)(_DWORD, _DWORD, _DWORD); // esi@9
    const unsigned __int16 *v3; // ebx@11
    VARIANT *result; // eax@14
    unsigned int v5; // esi@18
    int v6; // eax@31
    int v7; // esi@34
    int v8; // eax@34
    int v9; // esi@38
    VARIANT *v10; // esi@40
    LONG v11; // eax@53
    LONG v12; // eax@55
    int v13; // eax@56
    int v14; // eax@57
    int v15; // [sp+Ch] [bp-14h]@35
    int v16; // [sp+10h] [bp-10h]@33
    unsigned int bCurrency; // [sp+14h] [bp-Ch]@1
    int v18; // [sp+18h] [bp-8h]@34
    BSTR bstrString; // [sp+1Ch] [bp-4h]@1

    vt = pVar->vt & 0x9FFF;
    bCurrency = (pVar->vt >> 13) & 1;
    bstrString = 0;
    if ( vt > VT_UNKNOWN )
    {
        if ( vt == VT_DECIMAL || vt == VT_UI1 )
        {
            goto DecimalOrUI1;
        }
        if ( vt != VT_RECORD )
        {
            goto LABEL_44;
        }
        if ( dword_65246024 )
        {
            EbRaiseExceptionCode(VT_UNKNOWN);
        }
        if ( !bCurrency )
        {
            if ( pVar->cyVal.Hi && (*(*pVar->cyVal.Hi + 28))(pVar->cyVal.Hi, &pVar) >= 0 )
            {
                return pVar;
            }
            goto LABEL_50;
        }
        if ( pVar->vt & VT_BYREF && (v11 = pVar->lVal, *v11) && *(*v11 + 2) & 0x20 )
        {
            v12 = *pVar->plVal;
        }
        else if ( pVar->vt & VT_BYREF || (v12 = pVar->lVal, !(*(v12 + 2) & 0x20)) || !*(v12 - 4) )
        {
            v3 = off_6524FDD0;
            goto LABEL_17;
        }
        v13 = (*(**(v12 - 4) + 28))(*(v12 - 4), &bstrString);
        if ( v13 < 0 )
        {
            v14 = EberrOfHresult(v13);
            EbRaiseExceptionCode(v14);
        }
        v3 = bstrString;
LABEL_17:
        if ( bCurrency )
        {
            v5 = wcslen(v3);
            pVar = SysAllocStringLen(0, v5 + 2);
            if ( !pVar )
            {
                EbRaiseExceptionCode(14);
            }
            sub_65012860(&pVar->vt, v5 + 3, v3);
            v6 = 2 * v5;
            *(&pVar->vt + v6) = 40;
            *(&pVar->wReserved1 + v6) = 41;
            *(&pVar->vt + v5 + 2) = 0;
            goto LABEL_13;
        }
LABEL_12:
        pVar = SysAllocString(v3);
        if ( !pVar )
        {
            EbRaiseExceptionCode(14);
        }
LABEL_13:
        SysFreeString(bstrString);
        return pVar;
    }
    if ( vt == VT_UNKNOWN )
    {
        goto LABEL_6;
    }
    if ( vt < 0 )
    {
LABEL_44:
        EbRaiseExceptionCode(458);
    }
    if ( vt <= 8 )
    {
DecimalOrUI1:
        v3 = (&off_6524FD88)[2 * vt];
        goto LABEL_17;
    }
    if ( vt != 9 )
    {
        if ( vt <= 9 )
        {
            goto LABEL_44;
        }
        if ( vt > 11 )
        {
            if ( vt == 12 )
            {
LABEL_19:
                if ( dword_65246024 )
                {
                    EbRaiseExceptionCode(VT_UNKNOWN);
                }
                goto DecimalOrUI1;
            }
            goto LABEL_44;
        }
        goto DecimalOrUI1;
    }
LABEL_6:
    if ( bCurrency )
    {
        goto LABEL_19;
    }
    if ( dword_65246024 )
    {
        EbRaiseExceptionCode(VT_UNKNOWN);
    }
    if ( pVar->vt & 0x4000 )
    {
        v2 = *pVar->plVal;
    }
    else
    {
        v2 = pVar->lVal;
    }
    if ( !v2 )
    {
        v3 = L"Nothing";
        goto LABEL_12;
    }
    if ( (**v2)(v2, &IID_IProvideClassInfo, &v16) < 0 )
    {
        if ( (**v2)(v2, &IID_IDispatch, &v15) < 0 )
        {
LABEL_41:
            v3 = (&off_6524FD88)[2 * vt];
            goto LABEL_12;
        }
        v7 = (*(*v15 + 16))(v15, 0, 1033, &v18);
        v8 = v15;
    }
    else
    {
        v7 = (*(*v16 + 12))(v16, &v18);
        v8 = v16;
    }
    (*(*v8 + 8))(v8);
    if ( v7 < 0 )
    {
        goto LABEL_41;
    }
    v9 = (*(*v18 + 48))(v18, -1, &pVar, 0, 0, 0);
    (*(*v18 + 8))(v18);
    if ( v9 < 0 )
    {
LABEL_50:
        v3 = pVar;
        goto LABEL_12;
    }
    result = pVar;
    if ( 95 != pVar->vt )
    {
        return result;
    }
    v10 = SysAllocStringLen(&pVar->wReserved1, (pVar[-1].cyVal.Hi >> 1) - 1);
    SysFreeString(&pVar->vt);
    result = v10;
    return result;
}
 

File đính kèm

  • 1.png
    1.png
    37.4 KB · Đọc: 50
Upvote 0
vãi kinh lấy được cả code ... lạy luôn
 
Upvote 0
Vì vậy lúc trước mình đã có nói bên topic Optimize code VBA là không nên dùng hàm VBA TypeName, chỉ nên dùng VarType, rất nhanh.
 
Upvote 0
ThangCuAnh đã viết:
Cùng 1 code nhưng do compile trên VC++ trên 32bit và 64bit, compiler nó sinh mã khác nhau đôi chút bác. À mà hàm rtcTypeName phức tạp lắm bác Tuân à, dài khủng khiếp. Bác xem chi vậy ?
Hàm VarType của VBA = rtcVarType
Mã: 
int __stdcall rtcVarType(VARIANT *pv)
{
    return (unsigned __int16) GetVarType(pv);
}

__int16 __stdcall GetVarType(VARIANT *pv)
{
    VARTYPE l_vt; // si@3
    LONG lVal; // ecx@4
    int nRet; // edi@7
    int vt; // eax@1
    char excpBuf[32]; // [sp+4h] [bp-30h]@7
    VARIANTARG pvarg; // [sp+24h] [bp-10h]@3

    vt = pv->vt & 0xBFFF;
    if ( vt != VT_DISPATCH )
    {
        return vt;
    }
    if ( pv->vt & VT_BYREF )
    {
        lVal = *pv->plVal;
    }
    else
    {
        lVal = pv->lVal;
    }

    pvarg.vt = 0;
    nRet = ErrObjDefault(lVal, 0, 0, 0, 0, 3, &pvarg, excpBuf);
    EbClearException(excpBuf);
    if ( nRet >= 0 )
    {
        l_vt = pvarg.vt;
        __vbaFreeVar(&pvarg);
        LOWORD(vt) = l_vt;
    }
    else
    {
        LOWORD(vt) = VT_DISPATCH;
    }
    return vt;
}
Bác thấy đấy VarType của VBA cũng như VarType của Delphi, chỉ cần check field vt của VARIANT, nếu VT_DISPATCH thì tùm lum thứ tiếp theo.
Hình như trong Delphi, unit Variants.pas, có hàm VarTypeAsString đó bác Tuân, nó cũng như TypeName (rtcTypeName) của VBA đó.
Bài đã được tự động gộp:

Bà con test giúp mình file ở post #8 nhé.
Nhấp chuột vào đây để mở rộng...

Cảm ơn anh. EM tìm hàm TypeName trong Delphi chưa thấy cái nào đùng kiểu của VBA. Hàm này nó trả về tên của đối tượng.
Ví dụ
?TypeName(ActiveCell) kết quả là "Range"

Trên Userform nếu két một control nào đó vào rồi test
?TypeName(control) nó sẽ trả về tên class của control đo. Ví dụ. Kết quả trả về như là "TextBox", "CommandButton"

Còn VarType trong VBA giống với VarType trong Delphi nó kiểm tra kiểu giá trị của biến kiểu VARIANT. Giá trị trả về là số kiểu Word
VT_I2, VT_I4, VT_BSTR, VT_DATE,...

(*) Nhìn quả code tạo hàm TypeName() đúng là khoai. Trong code đó nó còn call nhiều hàm con ở đâu đó nữa. Bác xem cách trả về của hàm TypeName như em mô tả, có hàm nào trong Delphi làm được điều đó không bác?
 
Upvote 0
Các hàm IsXXX trong VBA mà các bạn hay dùng cũng hoàn toàn dựa vào hàm VarType/GetVarType
Mã: 
// rtcIsArray = IsArray
unsigned int __stdcall rtcIsArray(VARIANT *pv)
{
    unsigned int varType; // eax@1

    LOWORD(varType) = GetVarType(pv);
    return -((varType >> 13) & 1);
}

// rtcIsEmpty = IsEmpty
__int16 __stdcall rtcIsEmpty(VARIANT *pv)
{
    return -(GetVarType(pv) == 0);
}

// rtcIsError = IsError
__int16 __stdcall rtcIsError(VARIANT *pv)
{
    return -(GetVarType(pv) == VT_ERROR);
}

// rtcIsMissing = IsMissing
signed int __stdcall rtcIsMissing(VARIANT *pVar)
{
    signed int result; // eax@2
    LONG lVal; // eax@4

    if ( 8204 != pVar->vt || (lVal = pVar->lVal, 1 != *lVal) || *(lVal + 16) )
    {
        result = rtIsMissing(pVar);
    }
    else
    {
        result = -1;
    }
    return result;
}

// rtcIsNull = IsNull
__int16 __stdcall rtIsNull(VARIANT *pv)
{
    return -(GetVarType(pv) == VT_NULL);
}

// rtcIsObject = IsObject
int __stdcall rtcIsObject(VARIANT *pV)
{
    return -((pV->vt & 0xBFFF) == VT_DISPATCH);
}
Bài đã được tự động gộp:

Hàm IsDate và IsNumeric hóa ra lại rất phức tạp
Mã: 
signed __int16 __stdcall rtcIsNumeric(VARIANT *pVar)
{
    VARTYPE vt; // dx@1
    signed __int16 wRet; // di@1
    __int16 l_vType; // ax@2
    LONG lVal; // ecx@13
    int vErr; // esi@15
    const OLECHAR *bStr; // esi@23
    LCID v8; // eax@29
    char excpBuf[32]; // [sp+8h] [bp-38h]@15
    VARIANTARG pvarg; // [sp+28h] [bp-18h]@1
    DOUBLE pdblOut; // [sp+38h] [bp-8h]@29

    vt = pVar->vt;
    wRet = 0;
    pvarg.vt = 0;
    if ( vt & VT_ARRAY )
    {
        return wRet;
    }
    l_vType = vt & 0xBFFF;
    if ( !(vt & 0xBFFF)
      || l_vType >= VT_I2 && l_vType <= VT_CY
      || l_vType == VT_BOOL
      || l_vType == VT_UI1
      || l_vType == VT_DECIMAL )
    {
        return -1;
    }
    if ( l_vType == VT_DISPATCH )
    {
        if ( vt & VT_BYREF )
        {
            lVal = *pVar->plVal;
        }
        else
        {
            lVal = pVar->lVal;
        }
        vErr = ErrObjDefault(lVal, 0, 0, 0, 0, 3, &pvarg, excpBuf);
        EbClearException(excpBuf);
        if ( vErr < 0 )
        {
            goto LABEL_30;
        }
        if ( !pvarg.vt
          || pvarg.vt >= VT_I2 && pvarg.vt <= VT_CY
          || pvarg.vt == VT_BOOL
          || pvarg.vt == VT_UI1
          || pvarg.vt == VT_DECIMAL )
        {
            return -1;
        }
        if ( pvarg.vt == VT_BSTR )
        {
            bStr = pvarg.bstrVal;
LABEL_28:
            if ( bStr )
            {
                v8 = rtUserDefaultLCID();
                wRet = -(VarR8FromStr(bStr, v8, 0, &pdblOut) >= 0);
            }
            goto LABEL_30;
        }
        goto LABEL_30;
    }
    if ( l_vType == VT_BSTR )
    {
        if ( vt & VT_BYREF )
        {
            bStr = *pVar->plVal;
        }
        else
        {
            bStr = pVar->bstrVal;
        }
        goto LABEL_28;
    }
LABEL_30:
    __vbaFreeVar(&pvarg);
    return wRet;
}
Vậy nên tránh hàm IsNumeric, IsDate này.
Bài đã được tự động gộp:

@Nguyễn Duy Tuân: nó nằm ở khúc call IDispatch và IProvideClassInfo đó bác. Các Object của Excel hay Office implement các Interface này và trả về typename đó.
 
Lần chỉnh sửa cuối:
Upvote 0
ThangCuAnh đã viết:
Bác Tuân muốn trên 32 hay 64bit ?
Nhờ các bác test giùm cu anh tui file này, xem giới hạn của SysAllocStringLen API trên Windows và máy các bác là bao nhiêu.
Theo lý thuyết, MS document thì trên 32bit là MAX_UINT = 0xFFFFFFFF nhưng hoàn toàn không phải vậy, nhỏ hơn nhiều.
Có 2 sub Test_xxx, các bạn chạy và chịu khó chờ xem ra kết quả bao nhiêu nhé. Máy càng mạnh, càng bộ nhớ nhiều càng tốt.
Nhấp chuột vào đây để mở rộng...

Em test file của bác trên Excel 32-bit thì 2 lệnh gọi test SysAllowStringLen đều bị lỗi "Overflow".

Em đọc trên trang "tổ sư" nói về kiểu String trong VBA thì nói độ rộng tối đa là 2^16 (fixed-length ) hoặc 2^31 (variable-length). Nhưng test với 2^31 cũng lỗi :) .

Vụ TypeName em sẽ tìm hiểu cách khai thác IDispatch xem sao. Thank bác!
 
Upvote 0
Để mình add Virtual Method Table của mấy interface này vào "rờ em", debug tiếp. Mà chắc đúng rồi đó. Phải implement IProvideClassInfo mới trả về typename được. Bác Tuân check nếu là IDispatch thì QueryInterface lấy IProvideClassInfo về, call method GetClassInfo để lấy ITypeInfo về, tiếp tục call, mò các method của ITypeInfo tiếp ra gì.

Vụ len thì MS "đồ cú mần" nói không đúng đâu bác Tuân, mới 0x3FFFFFFF đã văng rồi, bác chạy coi I xuống tới bao nhiêu là Space, Space$ thành công.
 

File đính kèm

  • 1.png
    1.png
    17.1 KB · Đọc: 36
Lần chỉnh sửa cuối:
Upvote 0
ThangCuAnh đã viết:
Để mình add Virtual Method Table của mấy interface này vào "rờ em", debug tiếp. Mà chắc đúng rồi đó.

Không đúng đâu bác Tuân, mới 0x3FFFFFFF đã văng rồi, bác chạy coi I xuống tới bao nhiêu là Space, Space$ thành công.
Nhấp chuột vào đây để mở rộng...

Thành công ở thông báo "3F9277EA" nhé bác.
 
Upvote 0
1,017 MB. Gần 1GB. Sao lại là số này nhỉ ? Chờ các bạn khác test xem sao. Vì debug vào SysAllocStringLen nó phức tạp quá, xuống tới tận tầng kernel, nên mình thua, không tìm ra đoạn nào giới hạn cái size này.
Test_rtcSpaceVar và Test_rtcSpaceBstr ra I khác nhau đó bác @Nguyễn Duy Tuân. Bác chạy cả 2 chưa ?
 
Lần chỉnh sửa cuối:
Upvote 0
kieu manh đã viết:
vãi kinh lấy được cả code ... lạy luôn
Nhấp chuột vào đây để mở rộng...
Thế nên giờ họ mới sinh ra mã nguồn mở, ngôn ngữ script (VBA cũng là 1 trong các dạng đó), và các ngôn ngữ lập trình dạng thông dịch lên ngôi,
Quan trọng là ý tưởng và xây dựng ý tưởng mới cần, không phải dăm ba cái code nhỏ
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

H
  • Question
Code subtotal và tìm điều kiện
Trả lời
11
Đọc
186
Hoàng Tuấn 868
H
A
Excel thiếu dữ liệu
Trả lời
3
Đọc
75
vietduc147258
V
S
Nhờ giúp đỡ code in toàn bộ danh sách có điều kiện
Trả lời
1
Đọc
32
BuiQuangThuan
B
A
Đếm dữ liệu với điều kiện
Trả lời
11
Đọc
97
DeTong
D
Maika8008
  • Question
Add-In .xlam trộn dữ liệu Excel vào Word
    • Thích
    • Yêu thích
    • Cảm ơn
2
Trả lời
29
Đọc
2K
vu_tuan_manh_linh
vu_tuan_manh_linh
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom