修复Delphi中DDE连接Edge失败无法获取当前URL的问题

问题背景 #

需将GitHub项目procrastitracker中的C++ DDE工具函数转换为Delphi，用于在Windows 10 22H2系统中获取Microsoft Edge的当前URL。转换完成后调用时，DdeConnect始终返回0，导致无法获取URL。

原C++实现代码 #

DWORD idInst = 0;
HDDEDATA CALLBACK DdeCallback(UINT uType, UINT uFmt, HCONV hconv, HSZ hsz1, HSZ hsz2,
                              HDDEDATA hdata, DWORD dwData1, DWORD dwData2) {
    return 0;
}
bool ddeinit() {
    return DdeInitialize(&idInst, (PFNCALLBACK)DdeCallback, APPCLASS_STANDARD | APPCMD_CLIENTONLY,
                         0) == DMLERR_NO_ERROR;
}
void ddeclean() {
    if (idInst) DdeUninitialize(idInst);
}

void ddereq(char *server, char *topic, char *item, char *buf, int len) {
    buf[0] = 0;
    HSZ hszApp = DdeCreateStringHandleA(idInst, server, 0);
    HSZ hszTopic = DdeCreateStringHandleA(idInst, topic, 0);
    HCONV hConv = DdeConnect(idInst, hszApp, hszTopic, NULL);
    DdeFreeStringHandle(idInst, hszApp);
    DdeFreeStringHandle(idInst, hszTopic);
    if (hConv == NULL) {
        // OutputDebugF("dde error: %x\n", DdeGetLastError(idInst));
        // DMLERR_NO_CONV_ESTABLISHED on chrome, see
        // https://bugs.chromium.org/p/chromium/issues/detail?id=70184
        return;
    }

    HSZ hszItem = DdeCreateStringHandleA(idInst, item, 0);
    HDDEDATA hData =
        DdeClientTransaction(NULL, 0, hConv, hszItem, CF_TEXT, XTYP_REQUEST, 5000, NULL);
    if (hData != NULL) {
        DdeGetData(hData, (unsigned char *)buf, len, 0);
        buf[len - 1] = 0;
        DdeFreeDataHandle(hData);
    } else {
        // OutputDebugF("dde error: %x\n", DdeGetLastError(idInst));
    }

    DdeFreeStringHandle(idInst, hszItem);

    DdeDisconnect(hConv);
}

C++调用方式：

ddereq("msedge", "WWW_GetWindowInfo", "0xFFFFFFFF", url, MAXTMPSTR);

转换后的Delphi代码（存在问题） #

var idInst : LongInt=0;

function DDECallback(CallType, Fmt: UINT; Conv: HConv; hsz1, hsz2: HSZ;
    Data: HDDEData; Data1, Data2: DWORD): HDDEData; stdcall;
begin
   Result:=0;
end;

function ddeinit:Boolean;
begin
    Result:=DdeInitializeA(idInst, @DDECallback, APPCLASS_STANDARD or APPCMD_CLIENTONLY,0)=DMLERR_NO_ERROR;
end;

procedure ddeclean;
begin
    if idInst<>0 then DdeUninitialize(idInst);
end;

procedure ddereq(server, topic, item : PAnsiChar;var Buff:String);
var
  hszApp,
  hszTopic : THandle;
  hConv    : THandle;
  hszItem  : THandle;
  hData    : HDDEDATA;
begin    
    hszApp := DdeCreateStringHandleA(idInst, server, 0);
    hszTopic := DdeCreateStringHandleA(idInst, topic, 0);
    hConv := DdeConnect(idInst, hszApp, hszTopic, nil);
    DdeFreeStringHandle(idInst, hszApp);
    DdeFreeStringHandle(idInst, hszTopic);
    if hConv = 0 then begin exit; end;

    hszItem := DdeCreateStringHandleA(idInst, item, 0);
    hData :=  DdeClientTransaction(nil, 0, hConv, hszItem, CF_TEXT, XTYP_REQUEST, 5000, nil);
    if hData <> 0 then begin
        DdeGetData(hData,@buff, SizeOf(Buff), 0);
        DdeFreeDataHandle(hData);
    end else ;

    DdeFreeStringHandle(idInst, hszItem);
    DdeDisconnect(hConv);

end;

Delphi调用方式：

ddereq('msedge', 'WWW_GetWindowInfo', '0xFFFFFFFF', url);

问题分析与修复方案 #

核心问题1：DDE初始化参数错误 #

DdeInitializeA的第一个参数要求是指针类型，但原Delphi代码直接传递了值类型的idInst，导致初始化失败，后续DdeConnect无法建立连接。

核心问题2：字符串处理错误 #

Delphi的String是动态类型，直接用@buff传递给DdeGetData会引发内存访问错误，且SizeOf(Buff)获取的是字符串指针大小，而非实际缓冲区的可用空间。

修复后的完整Delphi代码 #

unit DDEUtils;

interface

uses
  Windows, Messages;

var
  idInst: DWORD = 0;

function DDECallback(uType, uFmt: UINT; hConv: HCONV; hsz1, hsz2: HSZ;
  hData: HDDEDATA; dwData1, dwData2: DWORD): HDDEDATA; stdcall;
function DDEInit: Boolean;
procedure DDEClean;
procedure DDEReq(const Server, Topic, Item: AnsiString; var OutBuffer: AnsiString; BufferSize: Integer);

implementation

function DDECallback(uType, uFmt: UINT; hConv: HCONV; hsz1, hsz2: HSZ;
  hData: HDDEDATA; dwData1, dwData2: DWORD): HDDEDATA; stdcall;
begin
  Result := 0;
end;

function DDEInit: Boolean;
var
  Err: DWORD;
begin
  Err := DdeInitializeA(@idInst, @DDECallback, APPCLASS_STANDARD or APPCMD_CLIENTONLY, 0);
  Result := Err = DMLERR_NO_ERROR;
end;

procedure DDEClean;
begin
  if idInst <> 0 then
    DdeUninitialize(idInst);
end;

procedure DDEReq(const Server, Topic, Item: AnsiString; var OutBuffer: AnsiString; BufferSize: Integer);
var
  hszApp, hszTopic, hszItem: HSZ;
  hConv: HCONV;
  hData: HDDEDATA;
  TempBuffer: array of Byte;
begin
  OutBuffer := '';
  if idInst = 0 then Exit;

  // 创建字符串句柄
  hszApp := DdeCreateStringHandleA(idInst, PAnsiChar(Server), CP_ACP);
  hszTopic := DdeCreateStringHandleA(idInst, PAnsiChar(Topic), CP_ACP);
  if (hszApp = 0) or (hszTopic = 0) then
  begin
    if hszApp <> 0 then DdeFreeStringHandle(idInst, hszApp);
    if hszTopic <> 0 then DdeFreeStringHandle(idInst, hszTopic);
    Exit;
  end;

  // 建立DDE连接
  hConv := DdeConnect(idInst, hszApp, hszTopic, nil);
  // 连接建立后再释放字符串句柄
  DdeFreeStringHandle(idInst, hszApp);
  DdeFreeStringHandle(idInst, hszTopic);

  if hConv = 0 then Exit;

  try
    hszItem := DdeCreateStringHandleA(idInst, PAnsiChar(Item), CP_ACP);
    if hszItem = 0 then Exit;

    try
      // 发送请求
      hData := DdeClientTransaction(nil, 0, hConv, hszItem, CF_TEXT, XTYP_REQUEST, 5000, nil);
      if hData <> 0 then
      begin
        SetLength(TempBuffer, BufferSize);
        ZeroMemory(@TempBuffer[0], BufferSize);
        // 获取返回数据
        if DdeGetData(hData, @TempBuffer[0], BufferSize, 0) > 0 then
          OutBuffer := PAnsiChar(@TempBuffer[0]);
        DdeFreeDataHandle(hData);
      end;
    finally
      DdeFreeStringHandle(idInst, hszItem);
    end;
  finally
    DdeDisconnect(hConv);
  end;
end;

end.

修复后的调用示例 #

var
  EdgeURL: AnsiString;
begin
  if DDEInit then
  try
    SetLength(EdgeURL, 4096); // 预分配足够大小的缓冲区
    DDereq('msedge', 'WWW_GetWindowInfo', '0xFFFFFFFF', EdgeURL, Length(EdgeURL));
    EdgeURL := Trim(EdgeURL);
    // 使用获取到的EdgeURL
  finally
    DDEClean;
  end;
end;

额外注意事项 #

• 确保Microsoft Edge已启用DDE支持：部分新版本Edge默认关闭DDE，需在设置中开启（路径：设置 -> 系统和性能 -> 启用DDE）。
• 32位/64位兼容性：若Delphi程序为64位，需确保调用匹配位数的DDE函数，可使用宽字符版本DdeInitializeW或保持Ansi版本并匹配Edge的位数。
• 错误排查：DdeConnect失败后，可调用DdeGetLastError(idInst)获取具体错误码，针对性排查问题。

内容的提问来源于stack exchange，提问作者Vietdung