很奇怪的问题，程序占有率95%以上，没有响应。(100)

问题：点击button1后切换别的程序后，出现假死现象。请大家帮看看。下面是源码：请拷到新工程中添加几个按钮。即可运行。unit aprint;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,MSHTML, SHDOCVW,activex,sndkey32, ExtCtrls;type TForm1 = class(TForm) Button1: TButton; Memo1: TMemo; Button2: TButton; Button3: TButton; Button4: TButton; Button5: TButton; Edit1: TEdit; Edit2: TEdit; Label1: TLabel; Label2: TLabel; Button6: TButton; SB: TScrollBar; Label3: TLabel; procedure Delay(msecs: Longint); procedure getlastframe(Doc:IHTMLDocument2); procedure getItems(sDoc:string); procedure FillIEForm(aURL:string) ; procedure Button1Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure SBChange(Sender: TObject); procedure Printx(); procedure FormActivate(Sender: TObject); procedure FormCreate(Sender: TObject); procedure split(src,dec1,dec2 : string); private { Private declarations } public { Public declarations } end;var Form1: TForm1; WindowHandle:HWND; webdoc,tmpdoc,pwebdoc:IHTMLDocument2; fb:boolean; StrP,Nowp,entertimes,endP:integer; cmd : TStringList;implementation{$R *.dfm} procedure Tform1.Printx(); var j:integer; begin AppActivate('ZDSoft报表打印预览'); SendKeys('^P', false); for j:=1 to sb.Position do begin delay(500); sendkeys('~',false); end; end; procedure Tform1.split(src,dec1,dec2 : string);var i,j,c: integer; str : string;begin // result := TStringList.Create; c:=0; repeat i := pos(dec1,src); j := pos(dec2,src); str := copy(src,i,j-1); //str := copy(src,i,109); if (str='') and (i>0) and (j>i) then begin delete(src,1,i+length(dec1)-1); continue; end; if i>j then delete(src,1,i-2); if (i>0) and (j>i) then begin if length(str)<150 then begin // k:=pos('班',str); cmd.Add(str); inc(c); end; delete(src,1,i+length(dec1)-1); end; until i<=0; if (cmd.Count>0) and (fb=false) then begin fb:=true; webdoc:=tmpdoc; end; //if (src<>'')and (c=0) then result.Add('test');end;procedure Tform1.FillIEForm(aURL:string) ;var ShellWindow: IShellWindows; Web: IWebBrowser2; Dispatch: IDispatch; i,j:integer; IEAddress,sdoc:string; HTMLDocument:IHTMLDocument2; FrameWindow:IHTMLWindow2; Vi,Vj:OLEVariant; //HTMLFrameBase :IHTMLFrameBase ; //HTMLFrameElement:IHTMLFrameElement ; // HTMLIFrameElement:IHTMLIFrameElement;begin ShellWindow := CoShellWindows.Create; for i:=0 to ShellWindow.Count -1 do begin Vi:=i; Dispatch:=ShellWindow.Item(Vi); if Dispatch=nil then continue; Dispatch.QueryInterface(IWebBrowser2,Web); if Web<>nil then begin IEAddress:=Web.LocationURL; if Pos(aURL,IEAddress)>0 then //if 1=1 then begin Web.Document.QueryInterface(IHTMLDocument2,HTMLDocument); if HTMLDocument<>nil then begin if HTMLDocument.frames.length =0 then//无框架 begin { memo1.Lines.Add('No frames begin===================================='); memo1.Lines.Add(HTMLDocument.body.innerHTML); //HTMLDocument.body.innerHTML memo1.Lines.Add('No frames end===================================='); ElementCollection:=HTMLDocument.Get_All; //DoWithHtmlElement(ElementCollection); //} sdoc:=HTMLDocument.body.outerHTML; tmpdoc:=HTMLDocument; getitems(sdoc); //(WebBrowser1.Document as IHTMLDocument2).parentWindow.execScript( //'alert("hello");', 'javascript') { if slist.Count>0 then begin for k:=0 to slist.Count do begin HTMLDocument.parentWindow.execScript(slist.Strings[k], 'javascript') end; end; } end else//有框架 begin pwebdoc:= HTMLDocument; for j:=0 to HTMLDocument.frames.length -1 do begin Vj:=j; // showmessage(HTMLDocument.body.toString); Dispatch:=HTMLDocument.frames.item(Vj); // if Succeeded(Dispatch.QueryInterface(IHTMLFrameBase,HTMLFrameBase)) then if Succeeded(Dispatch.QueryInterface(IHTMLWindow2,FrameWindow)) then begin //showmessage(FrameWindow.document.body.outerHTML); //DoWithHtmlElement(FrameWindow.document.all); getLastFrame( FrameWindow.document); end; End; end; end; end; End; end;end;procedure Tform1.getlastframe(Doc:IHTMLDocument2);var ElementCollection:IHTMLElementCollection; FrameWindow:IHTMLWindow2; j:integer; Vj:OLEVariant; Dispatch: IDispatch; Sdoc:string; begin tmpdoc:=doc;if Doc.frames.length =0 then begin ElementCollection:=Doc.Get_All; { memo1.Lines.Add('No frames begin===================================='); memo1.Lines.Add(Doc.body.outerHTML); memo1.Lines.Add('No frames end===================================='); //} //DoWithHtmlElement(ElementCollection); sdoc:= Doc.body.outerHTML; getitems(sdoc); //(WebBrowser1.Document as IHTMLDocument2).parentWindow.execScript( //'alert("hello");', 'javascript') { if slist.count>1 then begin for k:=0 to slist.Count do begin AppActivate('ZDSoft报表打印预览'); Doc.parentWindow.execScript(slist.Strings[k], 'javascript') ; SendKeys('^P', false); sleep(500); sendkeys('~',false); sendkeys('~',false); sendkeys('~',false); end; end; } end else begin for j:=0 to Doc.frames.length -1 do begin Vj:=j; //memo1.Lines.Add(doc.body.outerHTML); Dispatch:=Doc.frames.item(Vj); if Succeeded(Dispatch.QueryInterface(IHTMLWindow2,FrameWindow)) then begin { memo1.Lines.Add('Frame begin===================================='); memo1.Lines.Add(FrameWindow.document.body.outerHTML); memo1.Lines.Add('Frame end===================================='); //} sdoc:= Doc.body.outerHTML; getitems(sdoc); //(WebBrowser1.Document as IHTMLDocument2).parentWindow.execScript( //'alert("hello");', 'javascript') { if slist.Count>0 then begin for k:=0 to slist.Count do begin doc.parentWindow.execScript(slist.Strings[k], 'javascript') end; end; // } //DoWithHtmlElement(FrameWindow.document.all); getLastFrame( FrameWindow.document); end; end; end;end;procedure TForm1.Button1Click(Sender: TObject);beginfb:=false;memo1.Clear; //以下代码是为了得到“确定”按钮的句柄 WindowHandle:=FindWindow(nil,'ZDSoft报表打印预览'); // fillIEform('xj');end;procedure Tform1.getitems(sdoc:string) ;vars1,dec1,dec2:string;begin//s1:='treeItemClick(''id=152A999F-8945-4747-8E87-4346A1A6B6EC'',''5'',''徐辉灿'',''3B92225B-F1D0-4ED1-8CD7-B06AFA9A37CF'')">徐辉灿</A></DIV>''';s1:=sdoc;dec1:='treeItemClick';dec2:=')">';split(s1,dec1,dec2);//s2:=copy(ss.Strings[0],1,length(ss.strings[0])-1);end;procedure TForm1.Button3Click(Sender: TObject);vari:integer;begin for i:=1 to 2 do begin // memo1.Lines.Strings webDoc.parentWindow.execScript(memo1.Lines.Strings, 'javascript') ; delay(50); pwebDoc.parentWindow.execScript('chinaExcelContainer.chinaExcelPrint();', 'javascript') ; end;end;procedure TForm1.Button2Click(Sender: TObject);var i,j:integer;begin {AppActivate('ZDSoft报表打印预览'); SendKeys('^P', false); delay(100); sendkeys('~',false);} //for i:=1 to memo1.Lines.Count do for i:=1 to 2 do begin // memo1.Lines.Strings webDoc.parentWindow.execScript(memo1.Lines.Strings, 'javascript') ; delay(50); webDoc.parentWindow.execScript(memo1.Lines.Strings, 'javascript') ; end;end;procedure TForm1.SBChange(Sender: TObject);begin label3.caption:='回车'+inttostr(sb.position)+'次'; entertimes:= sb.position;end;procedure TForm1.Delay(msecs: Longint);var I:Integer;var WaitedTime:Cardinal;begin WaitedTime:=0; while (WaitedTime<msecs) do begin SleepEx(100,False); Inc(WaitedTime,100); Application.ProcessMessages ; endend;procedure TForm1.FormActivate(Sender: TObject);begin//self.Memo1.OnEnter;end;procedure TForm1.FormCreate(Sender: TObject);begincmd:=Tstringlist.Create;end;end.

你的cmd变量在那里释放？

for j:=1 to sb.Position do begin delay(500); // 这里假死，应该为:_IDelay(500); sendkeys('~',false); end;Procedure _IDelay(_TimeWord); Begin _Time:=GetTickCount()+_Time; While (_Time>GetTickCount()) Do // 不会假死，但是CPU 100%占用 Application.ProcessMessages; End;

cmd是关闭程序后释放的。关于：wql的Procedure _IDelay(_TimeWord);我以前也用过，不过不是那个原因。执行后，都无法反应。

多人接受答案了。