AI muốn lập trình DLL cho Excel và các loại bằng Delphi thì xem video này nhé!

Liên hệ QC

Nguyễn Duy Tuân

Nghị Hách
Thành viên danh dự
Tham gia
13/6/06
Bài viết
4,649
Được thích
10,138
Giới tính
Nam
Nghề nghiệp
Giáo viên, CEO tại Bluesofts
Lần chỉnh sửa cuối:
Trời, cái hình chình ình vậy mà.
 
Upvote 0
Mình không có install Delphi, mà cũng bỏ lâu quá rồi nên có thể quên nhiều, viết sai, các bạn cứ theo cái sườn mình nghĩ trong đầu này mà compile, fix lỗi warning, error nhé. Miễn đúng sao nó ra đúng như cái hình trước. Mình code trên notepad thôi, và chỉ có đúng file Variants.pas bác @kieu manh up lên :)
Mã:
uses
  Variants, xxx; // Xem mấy cái IDispatch, IProvideClassInfo, ITypeInfo, IID_IProvideClassInfo, IID_IDispatch nằm trong unit nào của Delphi
....
interface
...
function TypeName4D(const pv: POleVariant): AnsiString; stdcall;
...
implementation

function TypeName4D(const pv: POleVariant): AnsiString;
var
  hr: HRESULT;
  vt: TVarType;
  strRet: WideString;
  pDisp, pChildDisp: IDispatch;
  pProvideClassInfo: IProvideClassInfo;
  pTypeInfo: ITypeInfo;
begin
  if (nil = pv) then Exit('Nothing');

  vt := VarType(pv^);
  if (vt and varTypeMask) <> varDispatch then Exit(VarTypeAsText(vt));

  if (vt and varByRef = 0) then
    pDisp := pv^.VDispatch
  else
    pDisp := pv^.VDispatch^;

  if (nil = pDisp) then Exit('Nothing');

  if Failed(pDisp.QueryInterface(IID_IProvideClassInfo, pProvideClassInfo) then
  begin
    if (Failed(pDisp.QueryInterface(IID_IDispatch, pChildDisp) then Exit('Object');
    hr := pChildDisp.GetTypeInfo(0, 1033, pTypeInfo);
    pProvideClassInfo := pChildDispatch;
  end
  else
    hr := pProvideClassInfo.GetClassInfo(pTypeInfo);

  pProvideClassInfo.Release;
  if Failed(hr) then Exit('Kekeke, Thằng Cu Anh failed :(');   // debug, test xem hr khai báo trên Delphi vậy đúng không, 2 chỗ hr := trả về gì ???

  pTypeInfo.GetDocumentation(-1, strRet, nil, nil, nil);  // Xem trong ITypeInfo của Delphi, GetDocumentation khai báo ra sao ???
  pTypeInfo.Release;

  Result := strRet;   // lanh chanh hả, convert về AnsiString cho tao :)
end;
Trên VBA, khai báo như sau:
Declare PtrSafe hay không safe gì đó Function TypeName4D(ByRef v As Variant) As String
VBA lanh chanh sau API call hả, tự convert ngược lại về Unicode string cho tao :)
Chúc may mắn nhen bà con :)
Khai báo lại từ file .h của C/C++ của Windows SDK từ Delphi coder hay lẫn lộn, không thống nhất giữa Pointer, var out, bà con cứ theo đúng cái khai báo trong file .pas nó ra sao mà làm, cho nó khỏi warning, error. Chứ thực ra, bản chất đều là Pointer, là con số địa chỉ hết. Cứ con số đúng thì nó chạy đúng, vậy thôi.

Nó còn 1, 2 dòng code ngay trên Result := strRet nữa, nhưng mình xóa để các bạn tự phát hiện ra và code thêm :p Rất đơn giản. Nó không ảnh hưởng gì tới kết quả hết, chỉ dư 1 vài ký tự ở đầu, do VC++ compiler nó tự động chèn vô.
 
Lần chỉnh sửa cuối:
Upvote 0
cái Vụ xxx đang tìm mờ cả mắt để test cái xem sao mà chưa thấy ;)
 
Upvote 0
Chắc là nó
Capture.JPG
 

File đính kèm

  • Winapi.ActiveX.rar
    49.1 KB · Đọc: 3
Upvote 0
Mình không có install Delphi, mà cũng bỏ lâu quá rồi nên có thể quên nhiều, viết sai, các bạn cứ theo cái sườn mình nghĩ trong đầu này mà compile, fix lỗi warning, error nhé. Miễn đúng sao nó ra đúng như cái hình trước. Mình code trên notepad thôi, và chỉ có đúng file Variants.pas bác @kieu manh up lên :)
Mã:
uses
  Variants, xxx; // Xem mấy cái IDispatch, IProvideClassInfo, ITypeInfo, IID_IProvideClassInfo, IID_IDispatch nằm trong unit nào của Delphi
....
interface
...
function TypeName4D(const pv: POleVariant): AnsiString; stdcall;
...
implementation

function TypeName4D(const pv: POleVariant): AnsiString;
var
  hr: HRESULT;
  vt: TVarType;
  strRet: WideString;
  pDisp, pChildDisp: IDispatch;
  pProvideClassInfo: IProvideClassInfo;
  pTypeInfo: ITypeInfo;
begin
  if (nil = pv) then Exit('Nothing');

  vt := VarType(pv^);
  if (vt and varDispatch <> 0) then Exit(VarTypeAsText(vt));

  if (vt and varByRef = 0) then
    pDisp := pv^.VDispatch
  else
    pDisp := pv^.VDispatch^;

  if (nil = pDisp) then Exit('Nothing');

  if Failed(pDisp.QueryInterface(IID_IProvideClassInfo, pProvideClassInfo) then
  begin
    if (Failed(pDisp.QueryInterface(IID_IDispatch, pChildDisp) then Exit('Object');
    hr := pChildDisp.GetTypeInfo(0, 1033, pTypeInfo);
    pProvideClassInfo := pChildDispatch;
  end
  else
    hr := pProvideClassInfo.GetClassInfo(pTypeInfo);

  pProvideClassInfo.Release;
  if Failed(hr) then Exit('Kekeke, Thằng Cu Anh failed :(');   // debug, test xem hr khai báo trên Delphi vậy đúng không, 2 chỗ hr := trả về gì ???

  pTypeInfo.GetDocumentation(-1, strRet, nil, nil, nil);  // Xem trong ITypeInfo của Delphi, GetDocumentation khai báo ra sao ???
  pTypeInfo.Release;

  Result := strRet;   // lanh chanh hả, convert về AnsiString cho tao :)
end;
Trên VBA, khai báo như sau:
Declare PtrSafe hay không safe gì đó Function TypeName4D(ByRef v As Variant) As String
VBA lanh chanh sau API call hả, tự convert ngược lại về Unicode string cho tao :)
Chúc may mắn nhen bà con :)
Khai báo lại từ file .h của C/C++ của Windows SDK từ Delphi coder hay lẫn lộn, không thống nhất giữa Pointer, var out, bà con cứ theo đúng cái khai báo trong file .pas nó ra sao mà làm, cho nó khỏi warning, error. Chứ thực ra, bản chất đều là Pointer, là con số địa chỉ hết. Cứ con số đúng thì nó chạy đúng, vậy thôi.

Nó còn 1, 2 dòng code ngay trên Result := strRet nữa, nhưng mình xóa để các bạn tự phát hiện ra và code thêm :p Rất đơn giản. Nó không ảnh hưởng gì tới kết quả hết, chỉ dư 1 vài ký tự ở đầu, do VC++ compiler nó tự động chèn vô.

Các khai báo IID_IProvideClassInfo trong C/C++ thì Delphi nó dùng thẳng tên interface là IProvideClassInfo và nó đều nằm trong unit "ActiveX". Các trường hợp khác cũng như vậy.


Từ cái ảnh "rờ e" phía trên em cũng chỉnh lại hàm và hàm TypeName đã 100% như của VBA :) .
 
Upvote 0
Good đó Tuân, có những cái khác nhau rất tinh tế, hiểu 1 chút là ra hết
 
Upvote 0
Bữa nay anh nhậu say, anh có cảm giác buồn. Hình như mới người trên Gpe này kg thích anh. Chắc có lẽ cái thẳng tính, cầu toàn, bắt bẻ mọi cái sai nhỏ nhất của họ, muốn phải đúng Xyz theo ý mình, làm họ giận
Cái cuối cùng mình muốn, là tốt hết, nhưng lại bị mang tội khẩu nghiệp
Buồn, anh quay về với cõi tu
 
Upvote 0
Bữa nay anh nhậu say, anh có cảm giác buồn. Hình như mới người trên Gpe này kg thích anh. Chắc có lẽ cái thẳng tính, cầu toàn, bắt bẻ mọi cái sai nhỏ nhất của họ, muốn phải đúng Xyz theo ý mình, làm họ giận
Cái cuối cùng mình muốn, là tốt hết, nhưng lại bị mang tội khẩu nghiệp
Buồn, anh quay về với cõi tu

Trên GPE này rất đa dạng nhu cầu mà anh. Ai biết gì thì share đó ắt sẽ có những người khác cần mà. Kiến thức hay tính cách con người em thấy cũng đều cần có thời gian để ngấm và thích nghi bác nhỉ :p .
 
Lần chỉnh sửa cuối:
Upvote 0
Bữa nay anh nhậu say, anh có cảm giác buồn. Hình như mới người trên Gpe này kg thích anh. Chắc có lẽ cái thẳng tính, cầu toàn, bắt bẻ mọi cái sai nhỏ nhất của họ, muốn phải đúng Xyz theo ý mình, làm họ giận
Cái cuối cùng mình muốn, là tốt hết, nhưng lại bị mang tội khẩu nghiệp
Buồn, anh quay về với cõi tu
Nếu có dịp qua Bình Dương Alo Mạnh đón ... Nhậu vài lon Tel: 0929.555.666
 
Upvote 0
Mình không có install Delphi, mà cũng bỏ lâu quá rồi nên có thể quên nhiều, viết sai, các bạn cứ theo cái sườn mình nghĩ trong đầu này mà compile, fix lỗi warning, error nhé. Miễn đúng sao nó ra đúng như cái hình trước. Mình code trên notepad thôi, và chỉ có đúng file Variants.pas bác @kieu manh up lên :)
Mã:
uses
  Variants, xxx; // Xem mấy cái IDispatch, IProvideClassInfo, ITypeInfo, IID_IProvideClassInfo, IID_IDispatch nằm trong unit nào của Delphi
....
interface
...
function TypeName4D(const pv: POleVariant): AnsiString; stdcall;
...
implementation

function TypeName4D(const pv: POleVariant): AnsiString;
var
  hr: HRESULT;
  vt: TVarType;
  strRet: WideString;
  pDisp, pChildDisp: IDispatch;
  pProvideClassInfo: IProvideClassInfo;
  pTypeInfo: ITypeInfo;
begin
  if (nil = pv) then Exit('Nothing');

  vt := VarType(pv^);
  if (vt and varDispatch <> 0) then Exit(VarTypeAsText(vt));

  if (vt and varByRef = 0) then
    pDisp := pv^.VDispatch
  else
    pDisp := pv^.VDispatch^;

  if (nil = pDisp) then Exit('Nothing');

  if Failed(pDisp.QueryInterface(IID_IProvideClassInfo, pProvideClassInfo) then
  begin
    if (Failed(pDisp.QueryInterface(IID_IDispatch, pChildDisp) then Exit('Object');
    hr := pChildDisp.GetTypeInfo(0, 1033, pTypeInfo);
    pProvideClassInfo := pChildDispatch;
  end
  else
    hr := pProvideClassInfo.GetClassInfo(pTypeInfo);

  pProvideClassInfo.Release;
  if Failed(hr) then Exit('Kekeke, Thằng Cu Anh failed :(');   // debug, test xem hr khai báo trên Delphi vậy đúng không, 2 chỗ hr := trả về gì ???

  pTypeInfo.GetDocumentation(-1, strRet, nil, nil, nil);  // Xem trong ITypeInfo của Delphi, GetDocumentation khai báo ra sao ???
  pTypeInfo.Release;

  Result := strRet;   // lanh chanh hả, convert về AnsiString cho tao :)
end;
Trên VBA, khai báo như sau:
Declare PtrSafe hay không safe gì đó Function TypeName4D(ByRef v As Variant) As String
VBA lanh chanh sau API call hả, tự convert ngược lại về Unicode string cho tao :)
Chúc may mắn nhen bà con :)
Khai báo lại từ file .h của C/C++ của Windows SDK từ Delphi coder hay lẫn lộn, không thống nhất giữa Pointer, var out, bà con cứ theo đúng cái khai báo trong file .pas nó ra sao mà làm, cho nó khỏi warning, error. Chứ thực ra, bản chất đều là Pointer, là con số địa chỉ hết. Cứ con số đúng thì nó chạy đúng, vậy thôi.

Nó còn 1, 2 dòng code ngay trên Result := strRet nữa, nhưng mình xóa để các bạn tự phát hiện ra và code thêm :p Rất đơn giản. Nó không ảnh hưởng gì tới kết quả hết, chỉ dư 1 vài ký tự ở đầu, do VC++ compiler nó tự động chèn vô.
Sao ngắn gọn vậy anh, cao thủ cao thủ. Bao lau mới đạt được trình độ này nhỉ?
 
Lần chỉnh sửa cuối:
Upvote 0
Mới rảnh copy vào thử thêm uses: Winapi.ActiveX thì nó vẫn thiếu:
Capture.JPG
 
Upvote 0
Nó lỗi mấy dòng này
Mã:
if Failed(pDisp.QueryInterface(IID_IProvideClassInfo, pProvideClassInfo) then
  begin
    if (Failed(pDisp.QueryInterface(IID_IDispatch, pChildDisp) then Exit('Object');
    hr := pChildDisp.GetTypeInfo(0, 1033, pTypeInfo);
    pProvideClassInfo := pChildDispatch;
  end
  else
    hr := pProvideClassInfo.GetClassInfo(pTypeInfo);
  pProvideClassInfo.Release;
Capture.JPG
 
Upvote 0
Tôi đã hoàn thiện hàm API MyTypeName() lập trình trong Delphi. Tính năng giống 100% hàm TypeName của VBA.
Hàm này có tham khảo một đoạn ngắn ngủi "rờ em" MS Coder với mã ASM & C trong thư viện VBAxx của anh TQN.

Toàn bộ mã nguồn dưới đây tôi đã biên dịch DLL cho hai nền tảng 32 và 64-bit. Các bạn có thể tải về test. (Tôi thì đã test hết những tình huống mà tôi biết.

(*) Lưu ý: Đây là kiến thức Delphi ở dạng lập trình hệ thống, không phù hợp để học cho những người mới học Delphi. Bạn có thể copy về nghiên cứu sau khi đã học Delphi ở mức cơ bản. Hoặc coi như có hàm để ứng dụng luôn trong các dự abs Delphi để kiểm tra tên khai báo của các biến.

Mã:
//function VarTypeAsText() in unit System.Variants
//Upgraded by Nguyen Duy Tuan for VBA and Delphi
function VarTypeAsText(const AType: TVarType; const VBAType: Boolean = True): string;
const
  CText: array [Boolean, varEmpty..varUInt64] of string =
    (('Empty', 'Null', 'Smallint', //Do not localize
    'Integer', 'Single', 'Double', 'Currency', 'Date', 'OleStr', 'Dispatch', //Do not localize
    'Error', 'Boolean', 'Variant', 'Unknown', 'Decimal', '$0F', 'ShortInt', //Do not localize
    'Byte', 'Word', 'Cardinal', 'Int64', 'UInt64'), //Do not localize
    ('Empty', 'Null', 'Smallint', //Do not localize
    'Integer', 'Single', 'Double', 'Currency', 'Date', 'String', 'Object', //Do not localize
    'Error', 'Boolean', 'Variant', 'Unknown', 'Decimal', '$0F', 'ShortInt', //Do not localize
    'Byte', 'Word', 'Long', 'LongPtr', 'LongPtr')); //Do not localize

var
  LHandler: TCustomVariantType;
begin
  if (AType<=varUInt64) or ((AType and varTypeMask) <= varUInt64) then
    Result := CText[VBAType, AType and varTypeMask]
  else if AType = varString then
    Result := 'String' //Do not localize
  else if AType = varUString then
    Result := 'UnicodeString' //Do not localize
  else if AType = varAny then
    Result := 'Any' //Do not localize
  else if FindCustomVariantType(AType, LHandler) then
    Result := Copy(LHandler.ClassName, 2, High(Integer))
  else
    Result := HexDisplayPrefix + IntToHex(AType and varTypeMask, 4);

  if AType and varArray <> 0 then
    if VBAType then
      Result := Result + '()' //VBA Style
    else
      Result := 'Array ' + Result; //Do not localize
  if not VBAType and (AType and varByRef <> 0) then
    Result := 'ByRef ' + Result; //Do not localize
end;

//Function MyTypeName() return type of name as the same TypeName() in VBA
//Created by Nguyen Duy Tuan for
function MyTypeName(const v: PVariantArg; const VBAType: Wordbool = True): PWideChar; stdcall;
var
  s: PWideChar;
  TypeInfo: ITypeInfo;
  Disp, Another: IDispatch;
  ProviderClassInfor: IProvideClassInfo;
  hr: HRESULT;
  tmp: AnsiString;
begin
  hr := -1;
  if v^.vt and varTypeMask = VT_DISPATCH then
  begin
    if v^.vt and varByRef <>0 then
      Disp := IDispatch(v^.dispVal^)
    else
      Disp := IDispatch(v^.dispVal);
    if Disp = nil then
      s := 'Nothing' //from "rờ e" by TQN
    else
    if Disp.QueryInterface(IProvideClassInfo, ProviderClassInfor)<0 then
    begin
      if Disp.QueryInterface(IDispatch, Another)<0 then
        s := 'Object'
      else
      begin
        hr := Another.GetTypeInfo(0, 1033, TypeInfo);
        ProviderClassInfor := IProvideClassInfo(Another);
      end;
    end
    else
      hr := ProviderClassInfor.GetClassInfo(TypeInfo);

    if hr = S_OK then
    begin
      TypeInfo.GetDocumentation(MEMBERID_NIL, @s, nil, nil, nil);
      TypeInfo._Release;
      tmp := AnsiString(s);
      SysFreeString(s);
    end;

    if ProviderClassInfor <> nil then
      //ProviderClassInfor._Release; //crash Excel
  end
  else
    s := PWideChar(VarTypeAsText(v^.vt, Boolean(VBAType)));

  if Length(tmp)=0 then tmp := AnsiString(s);
  Result := SysAllocString(PWideChar(tmp+#0));
end;

223311

223312

Download DLL & Test
 
Upvote 0
Web KT
Back
Top Bottom