Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant
Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

Troubleshooting
Research
Professional Opinions
Ask a Question
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE

troubleshooting Question

Widechar to string problem in IqueryInfo.getInfoTip

Avatar of Mutley2003
Mutley2003 asked on
Delphi
4 Comments1 Solution591 ViewsLast Modified:
Hi
Maybe I don't understand widechar conversions well enough, but I keep crashing explorer with this very simple infotip handler.

The problem appears to be in the call to

function TInfoTip.GetInfoTip(dwFlags: DWORD; var ppwszTip: PWideChar): HResult;
var s: string; k: integer;
begin
  {
   I was getting an AV on this, so as per
   http://groups.google.com.au/group/borland.public.delphi.winapi/browse_thread/thread/8a53198eb63863b5/3958270207e305e5%233958270207e305e5
   I tried adding a couple of #0 .. nope, cannot do
   }
  //  s:= WidecharToString(ppwszTip+#0+#0);
  //  s:= WidecharLenToString(ppwszTip,50); // THIS STILL seems to be causing an AV

  // WideCharToStrVar(ppwszTip, s);  <<<<<<<<<   gives me an AV on files of type .fred

 ... I am STILL crashing Explorer, even though
  k := 0;
  while ppwszTip[k] <> #0 do begin
    Inc(k);
    if k > 1000 then break;
  end;
  if k >= 1000 then begin
    showmessage('why oh why?');
      Result := S_OK;
    exit;
  end;

  WideCharLenToStrVar(ppwszTip, 50, s); // should get around the 2048 limit
  if pos('_', fname) > 0 then
    ppwszTip := StringToOleStr('orignal=' + #13 + s) else

    // show a very basic infotip
    ppwszTip := StringToOleStr('this is my NEWEST info tip for: ' + #13 + fName);
  Result := S_OK;
end;


I thought then that it might be an unterminated string issue, but the code above should take care of that.

Then I thought that it might be a memory allocation issue, but if I cut the code back to
just  
 ppwszTip := StringToOleStr('this is my NEWEST info tip for: ' + #13 + fName);
it works OK.

So, what is going on, gurus?

Full code below.. as usual, thanks for help

library project1;

uses
  ComServ,
  Unit1 in 'Unit1.pas',
  project1_TLB in 'project1_TLB.pas';

exports
  DllGetClassObject,
  DllCanUnloadNow,
  DllRegisterServer,
  DllUnregisterServer;

{$R *.TLB}

{$R *.RES}

begin
end.



unit Unit1;

(*
 I manually registered this for .fred
 HKEY_CLASSES_ROOT\.fred\shellex\{00021500-0000-0000-C000-000000000046}

 see http://www.delphi3000.com/articles/article_950.asp?SK=

*)


// Project to create a very basic infotip shell extension using IQueryInfo and IPersistFile
// By: Greg Kempe (greg@kempe.net) -- 27 April 2000
// Article available at: http://www.delphi3000.com/

interface

uses
  ComObj,
  ShlObj,
  ActiveX,
  Windows;

const
  // GUID for our object
  CLSID_InfoTip: TGUID = '{088FB88B-09E0-4a8d-BF9A-EDCD8041EA1E}';

type
  TInfoTip = class(TComObject, IQueryInfo, IPersistFile)
  private
    fName: string;
  protected
    { IQueryInfo }
    function GetInfoTip(dwFlags: DWORD; var ppwszTip: PWideChar): HResult; stdcall;
    function GetInfoFlags(out pdwFlags: DWORD): HResult; stdcall;
    { IPersistFile }
    function IsDirty: HResult; stdcall;
    function Load(pszFileName: POleStr; dwMode: Longint): HResult; stdcall;
    function Save(pszFileName: POleStr; fRemember: BOOL): HResult; stdcall;
    function SaveCompleted(pszFileName: POleStr): HResult; stdcall;
    function GetCurFile(out pszFileName: POleStr): HResult; stdcall;
    function GetClassID(out classID: TCLSID): HResult; stdcall;
  end;

implementation

uses ComServ, dialogs;

{ TInfoTip }

function TInfoTip.GetClassID(out classID: TCLSID): HResult;
begin
  Result := E_NOTIMPL;
end;

function TInfoTip.GetCurFile(out pszFileName: POleStr): HResult;
begin
  Result := E_NOTIMPL;
end;

function TInfoTip.GetInfoFlags(out pdwFlags: DWORD): HResult;
begin
  Result := E_NOTIMPL;
end;

function TInfoTip.GetInfoTip(dwFlags: DWORD; var ppwszTip: PWideChar): HResult;
var s: string; k: integer;
begin
  {
   I was getting an AV on this, so as per
   http://groups.google.com.au/group/borland.public.delphi.winapi/browse_thread/thread/8a53198eb63863b5/3958270207e305e5%233958270207e305e5
   I tried adding a couple of #0 .. nope, cannot do
   }
  //  s:= WidecharToString(ppwszTip+#0+#0);
  //  s:= WidecharLenToString(ppwszTip,50); // THIS STILL seems to be causing an AV

  // WideCharToStrVar(ppwszTip, s);  <<<<<<<<<   gives me an AV on files of type .fred
  k := 0;
  while ppwszTip[k] <> #0 do begin
    Inc(k);
    if k > 1000 then break;
  end;
  if k >= 1000 then begin
    showmessage('why oh why?');
      Result := S_OK;
    exit;
  end;

  WideCharLenToStrVar(ppwszTip, 50, s); // should get around the 2048 limit
  if pos('_', fname) > 0 then
    ppwszTip := StringToOleStr('original=' + #13 + s) else

    // show a very basic infotip
    ppwszTip := StringToOleStr('this is my very newest info tip for: ' + #13 + fName);
  Result := S_OK;
end;

function TInfoTip.IsDirty: HResult;
begin
  Result := E_NOTIMPL;
end;

function TInfoTip.Load(pszFileName: POleStr; dwMode: Integer): HResult;
begin
  // save the filename for later use
  WideCharToStrVar(pszFileName, fName);
  Result := S_OK;
end;

function TInfoTip.Save(pszFileName: POleStr; fRemember: BOOL): HResult;
begin
  Result := E_NOTIMPL;
end;

function TInfoTip.SaveCompleted(pszFileName: POleStr): HResult;
begin
  Result := E_NOTIMPL;
end;

initialization
  TComObjectFactory.Create(ComServer, TInfoTip, CLSID_InfoTip, '', 'Test Info Tip', ciMultiInstance, tmApartment);
end.


ASKER CERTIFIED SOLUTION
Avatar of 2266180
Commented:
This problem has been solved!
Unlock 1 Answer and 4 Comments.
See Answers