疯狂VC站点>>疯狂VC技巧>>vc问答

vc问答

　　问：我想知道如何在自己的程序中向Windows 3.x和95/98中添加程序组。最好能给出一个同时适合于16位和32位Windows的代码，因为我这里不得不继续使用Windows 3.2中文版。

答：如果是单为Windows 95/98，那么只需要用ShellAPI中的几个函数就可以完成要求。但是如果要一种同时适合16位和32位Windows的方法，则应该通过DDE编程来实现。下面给出一个使用Borland Pascal 7编写的程序，它可以添加程序组和程序项。由于是采用OWL编程，因此这个程序很容易移植到Borland C++中去。
　　program PMDemo;
　　{$R pmrun.res}
　　uses WinTypes, WinProcs, OWindows, Strings, OStdDlgs;
　　{$I pmrun.inc}
　　const
　　 maxBufLen = 80;
　　 serverName = 'PROGMAN'; { 指定DDE服务器，对于这个例子，该服务器必须是PROGMAN }
　　 serverTopic = serverName;
　　type
　　 PMRunApp = object(TApplication)
　　 procedure InitMainWindow; virtual;
　　 end;
　　 PPMRunWindow = ^PMRunWindow;
　　 PMRunWindow = object(TWindow)
　　 LinkEstablished: boolean; { DDE是否处于连接中 }
　　 HWndPM: HWnd;
　　 constructor Init(AParent: PWindowsObject; ATitle: PChar);
　　function CanClose: boolean; virtual;
　　function GetCommand(Prompt, Buffer: PChar): boolean;
　　 function Linked: boolean;
　　 procedure SendPMCommand(P: PChar);
　　 procedure Execute(Prompt, Command: PChar);
　　 procedure WMDDEAck(var Msg: TMessage);
　　 virtual wm_First + wm_DDE_Ack; { DDE确认消息 }
　　 procedure WMDDETerminate(var Msg: TMessage);
　　 virtual wm_First + wm_DDE_Terminate; { DDE终止消息 }
　　 procedure CMCreateGroup(var Msg: TMessage);
　　 virtual cm_First + cm_CreateGroup;
　　 procedure CMAddItem(var Msg: TMessage);
　　 virtual cm_First + cm_AddItem;
　　 procedure CMShowGroup(var Msg: TMessage);
　　 virtual cm_First + cm_ShowGroup;
　　 procedure CMQuit(var Msg: TMessage);
　　 virtual cm_First + cm_ExitPro;
　　 end;
　　
　　procedure PMRunApp.InitMainWindow;
　　begin
　　 MainWindow := New(PPMRunWindow, Init(NIL, 'PMRun'));
　　end;
　　
　　constructor PMRunWindow.Init(AParent: PWindowsObject; ATitle: PChar);
　　begin
　　 TWindow.Init(AParent, ATitle);
　　 Attr.Menu := LoadMenu(HInstance, PChar(Menu_1));
　　 MessageBox(HWindow, 'PMDemo - Written by Jiang Hong', 'About', mb_OK);
　　 LinkEstablished := FALSE; { DDE此时没有连接 }
　　end;
　　
　　function PMRunWindow.CanClose: boolean;
　　begin
　　 { 当DDE正在连接时不能直接关闭应用程序，应该先使得DDE对话结束 }
　　 if LinkEstablished and IsWindow(HWndPM) then
　　 PostMessage(HWndPM, wm_DDE_Terminate, HWindow, 0);
　　 CanClose := TRUE;
　　end;
　　
　　function PMRunWindow.GetCommand(Prompt, Buffer: PChar): boolean;
　　begin
　　 Buffer[0] := #0;
　　 GetCommand :=
　　 (Application^.ExecDialog(New(PInputDialog,
　　 Init(@Self, 'Program Manager Command', Prompt,
　　 Buffer, maxBufLen + 1))) = id_OK) and (Strlen(Buffer) > 0);
　　end;
　　
　　procedure PMRunWindow.WMDDEAck(var Msg: TMessage);
　　var
　　 AppAtom, AppTopic: TAtom;
　　 HMem: THandle;
　　 DDEStatus: word;
　　begin
　　 if not LinkEstablished then begin
　　 LinkEstablished := TRUE;
　　 AppTopic := HiWord(Msg.LParam);
　　 AppAtom := LoWord(Msg.WParam);
　　 HWndPM := Msg.WParam;
　　 if AppAtom <> 0 then
　　 GlobalDeleteAtom(AppAtom);
　　 if AppTopic <> 0 then
　　 GlobalDeleteAtom(AppTopic);
　　 end else begin
　　 DDEStatus := LoWord(Msg.LParam);
　　 if (DDEStatus and DDE_Ack) <> DDE_Ack then
　　 MessageBox(HWindow, 'Command rejected by Program Manager',
　　 'Error', mb_OK);
　　 HMem := HiWord(Msg.LParam);
　　 if HMem <> 0 then
　　 GlobalFree(HMem);
　　 end;
　　end;
　　
　　procedure PMRunWindow.WMDDETerminate(var Msg: TMessage);
　　begin
　　 LinkEstablished := FALSE;
　　end;
　　
　　{ 判断DDE是否连接 }
　　function PMRunWindow.Linked: boolean;
　　var
　　 AppAtom, AppTopic: TAtom;
　　begin
　　 if not LinkEstablished then begin
　　 AppAtom := GlobalAddAtom(serverName);
　　 AppTopic := GlobalAddAtom(serverTopic);
　　 SendMessage(Word(-1), wm_DDE_Initiate, HWindow,
　　 MakeLong(AppAtom, AppTopic));
　　 GlobalDeleteAtom(AppAtom);
　　 GlobalDeleteAtom(AppTopic);
　　 end;
　　 Linked := LinkEstablished;
　　end;
　　
　　procedure PMRunWindow.SendPMCommand(P: PChar);
　　var
　　 HCmd: THandle;
　　 PCmd: PChar;
　　begin
　　 if Linked then begin
　　 HCmd := GlobalAlloc(gmem_Moveable or gmem_DDEShare, Strlen(P) + 1);
　　 if HCmd <> 0 then begin
　　 PCmd := GlobalLock(HCmd);
　　 if PCmd = NIL then
　　 GlobalFree(HCmd)
　　 else begin
　　 StrCopy(PCmd, P);
　　 GlobalUnlock(HCmd);
　　 if not PostMessage(HWndPM, wm_DDE_Execute, HWindow,
　　 MakeLong(0, HCmd)) then
　　 GlobalFree(HCmd);
　　 end;
　　 end;
　　 end else
　　 MessageBox(HWindow, 'Link to Program Manager failed', 'Note', mb_OK);
　　end;
　　
　　procedure PMRunWindow.Execute(Prompt, Command: PChar);
　　var
　　 P: PChar;
　　 Len: integer;
　　 Buffer: array[0..maxBufLen] of char;
　　begin
　　 if GetCommand(Prompt, Buffer) then begin
　　 Len := 5 + Strlen(Command) + Strlen(Buffer);
　　 GetMem(P, Len);
　　 if P = NIL then
　　 MessageBox(HWindow, 'Out of memory', 'Error', mb_OK)
　　 else begin
　　 StrCopy(P, '[');
　　 StrCat(P, Command);
　　 StrCat(P, '(');
　　 StrCat(P, Buffer);
　　 StrCat(P, ')]');
　　 SendPMCommand(P);
　　 FreeMem(P, Len);
　　 end;
　　 end;
　　end;
　　{
　　下面几个函数中调用Execute函数的第一个参数是实际使用时的格式。举例来说，如果要建立一个新的程序组My Group，该组位于C:\WIN31下，就要这样来写：
　　My Group,C:\WIN31
　　}
　　
　　procedure PMRunWindow.CMCreateGroup(var Msg: TMessage);
　　begin
　　 Execute('GroupName[,GroupPath]', 'CreateGroup');
　　end;
　　
　　procedure PMRunWindow.CMAddItem(var Msg: TMessage);
　　begin
　　 Execute('CmdLine[,Name[,IconPath[,IconIndex[,X,Y]]]]', 'AddItem');
　　end;
　　
　　procedure PMRunWindow.CMShowGroup(var Msg: TMessage);
　　begin
　　 Execute('GroupName,Command(1-8)', 'ShowGroup');
　　end;
　　
　　procedure PMRunWindow.CMQuit(var Msg: TMessage);
　　begin
　　 CloseWindow;
　　end;
　　
　　{ Main }
　　
　　var
　　 PRApp: PMRunApp;
　　
　　begin
　　 PRApp.Init('PMRunApp');
　　 PRApp.Run;
　　 PRApp.Done;
　　end.
　　实际上，上面程序所用的方法几乎是每一个基于Win16的安装程序所必须完成的步骤。
　　《电子与电脑》99年2期问与答