呵呵,为什么我这里一点错误也没有?Xavier和Steve最起码都能让他们的程序运行。如果这有这么大的错误,Xavier这个TeamB在Borland的新闻组岂不被骂死。

解决方案 »

  1.   

    机械工业出版社翻译出版的
    我自己都发现了不少错误,还花了我100多元钱
    to chechy:奇怪,为什么我这里有这么多错误?
    还是想出解决办法先?
      

  2.   

    我是SAMS出版社的啊,呵呵不太一样。是不是翻译的时候也偷工减料?
      

  3.   

    当然有光盘了,我可是花了US$50,才买来的。下面是你的源码:unit Detail9x;interfaceuses
      Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
      StdCtrls, ComCtrls, HeadList, TlHelp32, Menus, SysMain, DetBase;type
      TListType = (ltThread, ltModule, ltHeap);  TWin9xDetailForm = class(TBaseDetailForm)
        procedure DetailTabsChange(Sender: TObject);
        procedure FormCreate(Sender: TObject);
        procedure FormDestroy(Sender: TObject);
        procedure DetailLBDblClick(Sender: TObject);
      private
        FCurSnap: THandle;
        FCurProc: TProcessEntry32;
        DetailLists: array[TListType] of TStringList;
        ProcMem: PByte;
        HeapListAlloc: Boolean;
        procedure FreeHeapList;
        procedure ShowList(ListType: TListType);
        procedure WalkThreads;
        procedure WalkHeaps;
        procedure WalkModules;
      public
        procedure NewProcess(P: PProcessEntry32);
      end;procedure ShowProcessDetails(P: PProcessEntry32);implementation{$R *.DFM}uses ProcMem;const
      { Array of strings which goes into the header of each respective list. }
      HeaderStrs: array[TListType] of TDetailStrings = (
          ('Thread ID', 'Base Priority', 'Delta Priority', 'Usage Count'),
          ('Module', 'Base Addr', 'Size', 'Usage Count'),
          ('Heap ID', 'Base Addr', 'Size', 'Flags'));  { Array of strings which goes into the footer of each list. }
      ACountStrs: array[TListType] of string[31] = (
          'Total Threads: %d', 'Total Modules: %d', 'Total Heaps: %d');  TabStrs: array[TListType] of string[7] = ('Threads', 'Modules', 'Heaps');  SCaptionStr  = 'Details for %s';       // form caption
      SThreadStr   = '%x'#1'%s'#1'%s'#1'%d'; // id, base pri, delta pri, usage
      SModuleStr   = '%s'#1'$%p'#1'%d bytes'#1'%d'; // name, addr, size, usage
      SHeapStr     = '%x'#1'$%p'#1'%d bytes'#1'%s'; // ID, addr, size, flags
      SHeapReadErr = 'This heap is not accessible for read access.';  ProcMemMaxSize = $7FFE;                // max size of heap viewprocedure ShowProcessDetails(P: PProcessEntry32);
    var
      I: TListType;
    begin
      with TWin9xDetailForm.Create(Application) do
        try
          for I := Low(TabStrs) to High(TabStrs) do
            DetailTabs.Tabs.Add(TabStrs[I]);
          NewProcess(P);
          Font := MainForm.Font;
          ShowModal;
        finally
          Free;
        end;
    end;function GetThreadPriorityString(Priority: Integer): string;
    { Returns string describing thread priority }
    begin
      case Priority of
        THREAD_PRIORITY_IDLE:          Result := '%d (Idle)';
        THREAD_PRIORITY_LOWEST:        Result := '%d (Lowest)';
        THREAD_PRIORITY_BELOW_NORMAL:  Result := '%d (Below Normal)';
        THREAD_PRIORITY_NORMAL:        Result := '%d (Normal)';
        THREAD_PRIORITY_ABOVE_NORMAL:  Result := '%d (Above Normal)';
        THREAD_PRIORITY_HIGHEST:       Result := '%d (Highest)';
        THREAD_PRIORITY_TIME_CRITICAL: Result := '%d (Time critical)';
      else
        Result := '%d (unknown)';
      end;
      Result := Format(Result, [Priority]);
    end;function GetClassPriorityString(Priority: DWORD): String;
    { returns string describing process priority class }
    begin
      case Priority of
        4:   Result := '%d (Idle)';
        8:   Result := '%d (Normal)';
        13:  Result := '%d (High)';
        24:  Result := '%d (Real time)';
      else
        Result := '%d (non-standard)';
      end;
      Result := Format(Result, [Priority]);
    end;function GetHeapFlagString(Flag: DWORD): String;
    { Returns a string describing a heap flag }
    begin
      case Flag of
        LF32_FIXED:    Result := 'Fixed';
        LF32_FREE:     Result := 'Free';
        LF32_MOVEABLE: Result := 'Moveable';
      end;
    end;procedure TWin9xDetailForm.ShowList(ListType: TListType);
    { Shows appropriate thread, heap, or module list in DetailLB }
    var
      i: Integer;
    begin
      Screen.Cursor := crHourGlass;
      try
        with DetailLB do
        begin
          for i := 0 to 3 do
            Sections[i].Text := HeaderStrs[ListType, i];
          Items.Clear;
          Items.Assign(DetailLists[ListType]);
        end;
         DetailSB.Panels[0].Text := Format(ACountStrs[ListType],
           [DetailLists[ListType].Count]);
         if ListType = ltHeap then
           DetailSB.Panels[1].Text := 'Double-click to view heap'
         else
           DetailSB.Panels[1].Text := '';
      finally
        Screen.Cursor := crDefault;
      end;
    end;procedure TWin9xDetailForm.WalkThreads;
    { Uses ToolHelp32 functions to walk list of threads }
    var
      T: TThreadEntry32;
    begin
      DetailLists[ltThread].Clear;
      T.dwSize := SizeOf(T);
      if Thread32First(FCurSnap, T) then
        repeat
          { Make sure thread is for current process }
          if T.th32OwnerProcessID = FCurProc.th32ProcessID then
            DetailLists[ltThread].Add(Format(SThreadStr, [T.th32ThreadID,
              GetClassPriorityString(T.tpBasePri),
              GetThreadPriorityString(T.tpDeltaPri), T.cntUsage]));
        until not Thread32Next(FCurSnap, T);
    end;procedure TWin9xDetailForm.WalkModules;
    { Uses ToolHelp32 functions to walk list of modules }
    var
      M: TModuleEntry32;
    begin
      DetailLists[ltModule].Clear;
      M.dwSize := SizeOf(M);
      if Module32First(FCurSnap, M) then
        repeat
          DetailLists[ltModule].Add(Format(SModuleStr, [M.szModule, M.ModBaseAddr,
            M.ModBaseSize, M.ProcCntUsage]));
        until not Module32Next(FCurSnap, M);
    end;procedure TWin9xDetailForm.WalkHeaps;
    { Uses ToolHelp32 functions to walk list of heaps }
    var
      HL: THeapList32;
      HE: THeapEntry32;
      PHE: PHeapEntry32;
    begin
      DetailLists[ltHeap].Clear;
      HL.dwSize := SizeOf(HL);
      HE.dwSize := SizeOf(HE);
      if Heap32ListFirst(FCurSnap, HL) then
        repeat
          if Heap32First(HE, HL.th32ProcessID, HL.th32HeapID) then
            repeat
              New(PHE);      // need to make copy of THeapList32 record so we
              PHE^ := HE;    // have enough info to view heap later
              DetailLists[ltHeap].AddObject(Format(SHeapStr, [HL.th32HeapID,
                Pointer(HE.dwAddress), HE.dwBlockSize,
                GetHeapFlagString(HE.dwFlags)]), TObject(PHE));
            until not Heap32Next(HE);
        until not Heap32ListNext(FCurSnap, HL);
      HeapListAlloc := True;
    end;procedure TWin9xDetailForm.FreeHeapList;
    { Since special allocation of PHeapList32 objects are added to the list, }
    { these must be freed. }
    var
      i: integer;
    begin
      for i := 0 to DetailLists[ltHeap].Count - 1 do
        Dispose(PHeapEntry32(DetailLists[ltHeap].Objects[i]));
    end;procedure TWin9xDetailForm.NewProcess(P: PProcessEntry32);
    { This procedure is called from the main form to show the detail }
    { form for a particular process. }
    begin
      { Create a snapshot for the current process }
      FCurSnap := CreateToolhelp32Snapshot(TH32CS_SNAPALL, P^.th32ProcessID);
      if FCurSnap = INVALID_HANDLE_VALUE then
        raise Exception.Create('CreateToolHelp32Snapshot failed');
      HeapListAlloc := False;
      Screen.Cursor := crHourGlass;
      try
        FCurProc := P^;
        { Include module name in detail form caption }
        Caption := Format(SCaptionStr, [ExtractFileName(FCurProc.szExeFile)]);
        WalkThreads;                        // walk ToolHelp32 lists
        WalkModules;
        WalkHeaps;
        DetailTabs.TabIndex := 0;           // 0 = thread tab
        ShowList(ltThread);                 // show thread page first
      finally
        Screen.Cursor := crDefault;
        if HeapListAlloc then FreeHeapList;
        CloseHandle(FCurSnap);              // close snapshot handle
      end;
    end;procedure TWin9xDetailForm.DetailTabsChange(Sender: TObject);
    { OnChange event handler for tab set.  Sets visible list to jive with tabs. }
    begin
      inherited;
      ShowList(TListType(DetailTabs.TabIndex));
    end;procedure TWin9xDetailForm.FormCreate(Sender: TObject);
    var
      LT: TListType;
    begin
      inherited;
      { Dispose of lists }
      for LT := Low(TListType) to High(TListType) do
        DetailLists[LT] := TStringList.Create;
    end;procedure TWin9xDetailForm.FormDestroy(Sender: TObject);
    var
      LT: TListType;
    begin
      inherited;
      { Dispose of lists }
      for LT := Low(TListType) to High(TListType) do
        DetailLists[LT].Free;
    end;procedure TWin9xDetailForm.DetailLBDblClick(Sender: TObject);
    { This procedure is called when the user double clicks on an item }
    { in DetailLB.  If the current tab page is heaps, a heap view     }
    { form is presented to the user. }
    var
      NumRead: DWORD;
      HE: THeapEntry32;
      MemSize: integer;
    begin
      inherited;
      if DetailTabs.TabIndex = 2 then
      begin
        HE := PHeapEntry32(DetailLB.Items.Objects[DetailLB.ItemIndex])^;
        MemSize := HE.dwBlockSize;         // get heap size
        { if heap is too big, use ProcMemMaxSize }
        if MemSize > ProcMemMaxSize then MemSize := ProcMemMaxSize;
        ProcMem := AllocMem(MemSize);     // allocate a temp buffer
        Screen.Cursor := crHourGlass;
        try
          { Copy heap into temp buffer }
          if Toolhelp32ReadProcessMemory(FCurProc.th32ProcessID,
            Pointer(HE.dwAddress), ProcMem^, MemSize, NumRead) then
            { point HeapView control at temp buffer }
            ShowHeapView(ProcMem, MemSize)
          else
            MessageDlg(SHeapReadErr, mtInformation, [mbOk], 0);
        finally
          Screen.Cursor := crDefault;
          FreeMem(ProcMem, MemSize);
        end;
      end;
    end;end.
      

  4.   

    SAMS出版社是不是希望出版社?
      

  5.   

    chechy(chechy),你怎么买到原版的?
      

  6.   

    Amazon.com,不过现在邮费涨了。我打算到www.bn.com买Delphi 6 Developer's Guide。
      

  7.   

    to:chechy
    你用的都是正版?
      

  8.   

    to chechy:用你的源码也不行,还是有以上错误!
    关键为什么提示:
    [Error] ProcMem.pas(27): Undeclared identifier: : 'HeapView'
    [Error] Detail9x.pas(125): Undeclared identifier: 'DetailLB'
    谁能解决以上问题?
      

  9.   

    刚运行提示:
    class THeadlistbox not found!
      

  10.   

    to chechy:把你能运行这个程序的所有文件打包发到我的email,可以吗?
    [email protected]