Reinventing the wheel
April 18, 2024, 07:15:07 PM *
Welcome, Guest. Please login or register.
Did you miss your activation email?

Login with username, password and session length
News:
 
  Home Help Members Tags Login Register  
  Show Posts
Pages: 1 [2]
16  Archived (read-only) / News/Blog / VMWare: Cannot find a valid peer process to connect to on: May 15, 2009, 01:05:49 PM
I've read it all, but kind of hard to understand the problem,  I'll be more technomous after this. (^_^)
17  Site & Forum Feedback / Site Feedback / This website is a zombie on: May 15, 2009, 12:26:52 PM
Delphi zombie as we are called, zombies live forever and so we are.

...
...
...
...
...
...

Go and tell your friends about a zombie website.


...
...
...
...
...
...


rionroc
Delphi zombie


...
...
...
...
...
...


Cheers!
18  Product/Code Feedback / Delphi Tips/Articles/Examples / 'Enable/disable network adapters' code example on: May 15, 2009, 12:15:50 PM
Here is some code that should help get you started along. It is able to detect network changes, enumerate the adapter/interface pairs, and also allows you to disable/re-enable any specific interface. I am posting the sample app code first, then the component code. The component code requires the ip helper conversion units from jedi (the link is displayed in the component.).

If you have questions, please do not ask me,  ask Sir Ciuly, because he knows better than me.


Sample app code (form with 2 buttons and 1 memo on it)

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, NetState, IpRtrMib;

type
  TForm1 = class(TForm)
    Button1: TButton;
    NetAdapter1: TNetAdapter;
    Memo1: TMemo;
    Button2: TButton;
    procedure NetAdapter1Connect(Sender: TObject; IntfAdapter: _MIB_IFROW);
    procedure NetAdapter1Disconnect(Sender: TObject; IntfAdapter: _MIB_IFROW);
    procedure NetAdapter1StateChange(Sender: TObject; IntfAdapter: _MIB_IFROW; LastState, LastAdminState: Cardinal);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
{$R *.DFM}

procedure UpdateInfo(Memo: TMemo; Row: _MIB_IFROW);
begin
  with Memo do
  begin
     Lines.Add(Format('  Name: %s', [InterfaceName(Row)]));
     Lines.Add(Format('  Operational State: %d', [Row.dwOperStatus]));
     Lines.Add(Format('  Admin State: %d', [Row.dwAdminStatus]));
  end;
end;

procedure TForm1.NetAdapter1Connect(Sender: TObject; IntfAdapter: _MIB_IFROW);
begin
  Memo1.Lines.Add(Format('%s connected', [InterfaceName(IntfAdapter)]));
  UpdateInfo(Memo1, IntfAdapter);
end;

procedure TForm1.NetAdapter1Disconnect(Sender: TObject; IntfAdapter: _MIB_IFROW);
begin
  Memo1.Lines.Add(Format('%s disconnected', [InterfaceName(IntfAdapter)]));
  UpdateInfo(Memo1, IntfAdapter);
end;

procedure TForm1.NetAdapter1StateChange(Sender: TObject; IntfAdapter: _MIB_IFROW; LastState, LastAdminState: Cardinal);
begin
  Memo1.Lines.Add(Format('%s state change', [InterfaceName(IntfAdapter)]));
  UpdateInfo(Memo1, IntfAdapter);
  if InterfaceIsConnected(IntfAdapter) then
     Memo1.Lines.Add('-- Connected -- ')
  else
     Memo1.Lines.Add('-- Disconnected -- ');
end;

procedure TForm1.Button1Click(Sender: TObject);
var  dwIndex:       Integer;
begin
  for dwIndex:=0 to Pred(NetAdapter1.IntfAdapterCount) do
     NetAdapter1.DisableIntfAdapter(NetAdapter1[dwIndex]);
end;

procedure TForm1.Button2Click(Sender: TObject);
var  dwIndex:       Integer;
begin
  for dwIndex:=0 to Pred(NetAdapter1.IntfAdapterCount) do
     NetAdapter1.EnableIntfAdapter(NetAdapter1[dwIndex]);
end;


------------------- Component Code --------------------

unit NetState;
// http://ftp://delphi-jedi.org/api/IPHlpAPI.zip
interface

////////////////////////////////////////////////////////////////////////////////
//   Include Units (IP Helper units: http://ftp://delphi-jedi.org/api/IPHlpAPI.zip)
////////////////////////////////////////////////////////////////////////////////
uses
  Windows,
  SysUtils,
  Messages,
  Classes,
  Graphics,
  Controls,
  ExtCtrls,
  Forms,
  Dialogs,
  WinSock,
  WinInet,
  IpExport,
  IpHlpApi,
  IpTypes,
  IpIfConst,
  IpRtrMib;

////////////////////////////////////////////////////////////////////////////////
//   Network adapter constants
////////////////////////////////////////////////////////////////////////////////
const
  SPEED_MODEM          =  9600;

////////////////////////////////////////////////////////////////////////////////
//   Network adapter component
////////////////////////////////////////////////////////////////////////////////
type
  // Event handler type declarations
  TOnConnect           =  procedure(Sender: TObject; IntfAdapter: TMibIfRow) of object;
  TOnDisconnect        =  procedure(Sender: TObject; IntfAdapter: TMibIfRow) of object;
  TOnStateChange       =  procedure(Sender: TObject; IntfAdapter: TMibIfRow; LastState, LastAdminState: DWORD) of object;
  // Component declaration
  TNetAdapter          =  class(TComponent)
  private
     // Private declarations
     FTimer:           TTimer;
     FTable:           PMibIfTable;
     FOnConnect:       TOnConnect;
     FOnDisconnect:    TOnDisconnect;
     FOnStateChange:   TOnStateChange;
  protected
     // Protected declarations
     function          GetInterval: Integer;
     function          GetWatch: Boolean;
     function          GetIntfAdapters(Index: Integer): TMibIfRow;
     function          GetIntfAdapterCount: Integer;
     procedure         GetIntfAdapterTable;
     procedure         OnWatchFired(Sender: TObject);
     procedure         SetInterval(Value: Integer);
     procedure         SetWatch(Value: Boolean);
  public
     // Public declarations
     constructor       Create(AOwner: TComponent); override;
     destructor        Destroy; override;
     procedure         DisableIntfAdapter(Row: TMibIfRow);
     procedure         EnableIntfAdapter(Row: TMibIfRow);
     property          IntfAdapterCount: Integer read GetIntfAdapterCount;
     property          IntfAdapters[Index: Integer]: TMibIfRow read GetIntfAdapters; default;
  published
     // Published declarations
     property          OnConnect: TOnConnect read FOnConnect write FOnConnect;
     property          OnDisconnect: TOnDisconnect read FOnDisconnect write FOnDisconnect;
     property          OnStateChange: TOnStateChange read FOnStateChange write FOnStateChange;
     property          WatchChanges: Boolean read GetWatch write SetWatch;
     property          WatchInterval: Integer read GetInterval write SetInterval;
  end;

////////////////////////////////////////////////////////////////////////////////
//   Utility functions for handling of the interface row information
////////////////////////////////////////////////////////////////////////////////
function   InterfaceName(IntfAdapter: TMibIfRow): PChar;
function   InterfaceIsConnected(IntfAdapter: TMibIfRow): Boolean;
function   InterfaceIsModem(IntfAdapter: TMibIfRow): Boolean;

procedure Register;

implementation

function InterfaceName(IntfAdapter: TMibIfRow): PChar;
begin
  result:=PChar(@IntfAdapter.bDescr);
end;

function InterfaceIsConnected(IntfAdapter: TMibIfRow): Boolean;
begin
  result:=(IntfAdapter.dwAdminStatus = MIB_IF_ADMIN_STATUS_UP) and (IntfAdapter.dwOperStatus >= MIB_IF_OPER_STATUS_CONNECTED);
end;

function InterfaceIsModem(IntfAdapter: TMibIfRow): Boolean;
begin
  result:=((IntfAdapter.dwType = MIB_IF_TYPE_ETHERNET) and (IntfAdapter.dwSpeed = SPEED_MODEM)) or (IntfAdapter.dwType = MIB_IF_TYPE_PPP);
end;

// TNetAdapter
procedure TNetAdapter.DisableIntfAdapter(Row: TMibIfRow);
begin

  // Set admin status for row and call SetIfEntry
  Row.dwAdminStatus:=MIB_IF_ADMIN_STATUS_DOWN;

  // Set entry
  SetIfEntry(Row);

end;

procedure TNetAdapter.EnableIntfAdapter(Row: TMibIfRow);
begin

  // Set admin status for row and call SetIfEntry
  Row.dwAdminStatus:=MIB_IF_ADMIN_STATUS_UP;

  // Set entry
  SetIfEntry(Row);

end;

function TNetAdapter.GetInterval: Integer;
begin

  // Return the interval for the timer control
  result:=FTimer.Interval;

end;

function TNetAdapter.GetWatch: Boolean;
begin

  // Return the timer control enabled state
  result:=FTimer.Enabled;

end;

procedure TNetAdapter.SetInterval(Value: Integer);
begin

  // Update the timer control interval
  FTimer.Interval:=Value;

end;

procedure TNetAdapter.SetWatch(Value: Boolean);
begin

  // Update the timer control enabled state
  FTimer.Enabled:=Value;

end;

function TNetAdapter.GetIntfAdapters(Index: Integer): TMibIfRow;
begin

  // Check the table to make sure the request is in range
  if (FTable = nil) or (Index < 0) or (DWORD(Index) >= FTable^.dwNumEntries) then raise Exception.Create('Invalid Index');

  // Return the row
  result:=FTable^.Table[Index];

end;

function TNetAdapter.GetIntfAdapterCount: Integer;
begin

  // Check table
  if Assigned(FTable) then
     // Return the current count of interface/adapters
     result:=FTable^.dwNumEntries
  else
     // No table
     result:=0;

end;

procedure TNetAdapter.GetIntfAdapterTable;
var  lpIntfTable:   PMibIfTable;
     lpSwap:        Pointer;
     dwIndex:       ULONG;
     dwOldIndex:    ULONG;
     dwSize:        ULONG;
     bChanged:      Boolean;
     bExists:       Boolean;
begin

  // Set the default table
  lpIntfTable:=nil;

  // Make the call to get the required size
  try
     // Set the default size to allocate
     dwSize:=0;
     // Make the call to get the table size
     if (GetIfTable(nil, dwSize, True) = ERROR_INSUFFICIENT_BUFFER) then
     begin
        // Allocate memory for the table
        lpIntfTable:=AllocMem(dwSize);
        // Make the call again
        if (GetIfTable(lpIntfTable, dwSize, True) = NO_ERROR) then
        begin
           // We now have the table. If the old table is nil, then this is the
           // first call and there is nothing to compare to, so just assign the
           // table over.
           if (FTable = nil) then
           begin
              // Assign and clear var so the memory is not freed
              FTable:=lpIntfTable;
              lpIntfTable:=nil;
           end
           else
           begin
              // Swap table pointers
              lpSwap:=FTable;
              FTable:=lpIntfTable;
              lpIntfTable:=lpSwap;
              // Check for connects first and changes first
              for dwIndex:=0 to Pred(FTable^.dwNumEntries) do
              begin
                 // Check to see if this is a new entry
                 bExists:=False;
                 bChanged:=False;
                 dwOldIndex:=0;
                 while (dwOldIndex < lpIntfTable^.dwNumEntries) do
                 begin
                    // Check index
                    if (FTable^.table[dwIndex].dwIndex = lpIntfTable^.table[dwOldIndex].dwIndex) then
                    begin
                       // Entry exists
                       bExists:=True;
                       // Has it changed?
                       bChanged:=not((FTable^.table[dwIndex].dwAdminStatus = lpIntfTable^.table[dwOldIndex].dwAdminStatus) and
                                 (FTable^.table[dwIndex].dwOperStatus = lpIntfTable^.table[dwOldIndex].dwOperStatus));
                       // Done either way
                       break;
                    end;
                    // Next index
                    Inc(dwOldIndex);
                 end;
                 // Does the entry exist? If not, then we will need to fire a connect change
                 if bExists then
                 begin
                    // Check for change
                    if bChanged and Assigned(FOnStateChange) then
                       FOnStateChange(Self, FTable^.table[dwIndex], lpIntfTable^.table[dwOldIndex].dwOperStatus, lpIntfTable^.table[dwOldIndex].dwAdminStatus);
                 end
                 else if Assigned(FOnConnect) then
                    // Fire the OnConnect event
                    FOnConnect(Self, FTable^.table[dwIndex]);
              end;
              // Now we need to check for disconnects (those in old table but not in new)
              for dwOldIndex:=0 to Pred(lpIntfTable^.dwNumEntries) do
              begin
                 // Check to see if this entry still exists
                 bExists:=False;
                 dwIndex:=0;
                 while (dwIndex < FTable^.dwNumEntries) do
                 begin
                    // Check index
                    if (FTable^.table[dwIndex].dwIndex = lpIntfTable^.table[dwOldIndex].dwIndex) then
                    begin
                       // Entry exists
                       bExists:=True;
                       // Done either way
                       break;
                    end;
                    // Next index
                    Inc(dwIndex);
                 end;
                 // Does the entry exist? If not, then we will need to fire a disconnect event
                 if not(bExists) and Assigned(FOnDisconnect) then FOnDisconnect(Self, lpIntfTable^.table[dwOldIndex]);
              end;
           end;
        end;
     end;
  finally
     // Free the table memory
     if Assigned(lpIntfTable) then FreeMem(lpIntfTable);
  end;

end;

procedure TNetAdapter.OnWatchFired(Sender: TObject);
begin

  // Resource protection
  try
     // Disable the timer
     FTimer.Enabled:=False;
     // Update the network interface table
     GetIntfAdapterTable;
  finally
     // Re-enable the timer
     FTimer.Enabled:=True;
  end;

end;

constructor TNetAdapter.Create(AOwner: TComponent);
begin

  // Perform inherited
  inherited Create(AOwner);

  // Starting defaults
  FTimer:=TTimer.Create(Self);
  FTimer.Interval:=1000;
  FTimer.Enabled:=False;
  FTimer.OnTimer:=OnWatchFired;
  FTable:=nil;

  // Load the initial table
  GetIntfAdapterTable;

end;

destructor TNetAdapter.Destroy;
begin

  // Stop and free the timer
  FTimer.Enabled:=False;
  FTimer.Free;

  // Free memory allocated for the table
  if Assigned(FTable) then FreeMem(FTable);

  // Perform inherited
  inherited Destroy;

end;

procedure Register;
begin

  // Register the component with the IDE
  RegisterComponents('Additional', [TNetAdapter]);

end;

end.


Got it from other sites. (^_^)
And a sample code in zip format that may help you analyze:
http://www.yeahware.com/download/enable.zip


rionroc
Delphi zombie, because delphi is always alive.
19  Archived (read-only) / News/Blog / Programmer dad - the early years on: May 14, 2009, 06:37:46 PM
O boy, I like the picture very much.  I enjoy looking at it.
 Shocked
20  Site & Forum Feedback / Forum Feedback / Lets turn this forum into a Delphi Zombies forum on: May 14, 2009, 06:28:07 PM
What do you think peps?

Delphi zombies are Delphi application programmers/developers.

Tell the others about this web site.
21  General / Chit Chat / Whats your Web Chat ID on: May 14, 2009, 06:22:12 PM
Mine is: rocarobin@yahoo.com
See ya ther
Cheers!

Whats yours? Delphi Zombies!
22  General / Chit Chat / My program in softpedia on: May 14, 2009, 04:38:36 PM
http://www.softpedia.com/get/Network-Tools/Network-Monitoring/NeDesMo.shtml

I thought Delphi is dead, and so we are zombies.  But zombies are always alive and so is Delphi.


Cheers!
23  Product/Code Feedback / Delphi Tips/Articles/Examples / Delphi is back on: May 14, 2009, 05:54:14 AM
For now we are zombies, and Delphi is dead

But read this article:
http://edn.embarcadero.com/article/39174

"
But you guys have about ten bazillion lines of code out there that you want to continue to work. We totally get that. So, we are working to create a “new Delphi” and a new compiler architecture, to keep your existing code working, to emit 64-bit binaries using both Delphi and C++Builder, and maybe a few other kind of binaries while we are at it. And it all has to be done right so that it all works for you.

And you know what? That is exactly what we plan to do.
"

Cheers!
Were all excited!
24  General / Chit Chat / Sir Ciuly's Published program's in softpedia on: May 13, 2009, 08:00:41 PM
http://www.softpedia.com/progMoreBy/Publisher-Ciuly-9388.html Cheesy

Amazing...
25  General / Chit Chat / How to on: May 13, 2009, 07:11:57 PM
How to change from mouseover to mousedown using the infotip?
Or
How to put ActiveX infoTip to Form?

Here are sample code, that I applied to mix, but I'm lost.
http://www.delphi3000.com/articles/article_950.asp?SK=
http://delphi.about.com/library/weekly/aa121404b.htm


This is also the code that I updated, but I failed to fix it.
====================================
//Edited by me, but failed.
unit Unit1;
// 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}';
  xCLSID_InfoTip : TGUID = '{098FB88B-09E0-5a8d-BF9A-DDCD8041EA1F}';
 
type
  itip = interface
  ['{098FB88B-09E0-5a8d-BF9A-DDCD8041EA1F}']
  function dfname:string; stdcall;
  end;
 
type
titip = class(TComobject, itip)
  private
     dinfo:string;
  protected
  function dfname:string; stdcall;
  end;
 
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;
 
var finfo:string;
 
{ TInfoTip }
 
function TInfoTip.GetClassID(out classID: TCLSID): HResult;
begin
  Result := E_NOTIMPL;
end;
 
function TInfoTip.GetCurFile(out pszFileName: POleStr): HResult; export;
begin
  //Result := E_NOTIMPL;
  WideCharToStrVar(pszFileName, finfo);
  Result := S_OK;
end;
 
function TInfoTip.GetInfoFlags(out pdwFlags: DWORD): HResult;
begin
  Result := E_NOTIMPL;
end;
 
function TInfoTip.GetInfoTip(dwFlags: DWORD; var ppwszTip: PWideChar): HResult;
begin
  // show a very basic infotip
  ppwszTip := StringToOleStr('The infotip3 for: ' + #13 + fName);
  finfo:=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);
  WideCharToStrVar(pszFileName, finfo);
  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;
 
function titip.dfname:string; export;
begin
  dinfo:=finfo;
  Result := dinfo;
end;
 
initialization
  TComObjectFactory.Create(ComServer, TInfoTip, CLSID_InfoTip, '', 'Test Info Tip', ciMultiInstance, tmApartment);
  TComObjectFactory.Create(ComServer, titip, xCLSID_InfoTip, 'Just a test1', 'Just a test11', ciMultiInstance, tmApartment);
 
end.
 

 
-------------------------------------------------------
And my Form to show the Filename and Path::::
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComObj, ActiveX, ExtCtrls;
 
const
  xCLSID_InfoTip : TGUID = '{098FB88B-09E0-5a8d-BF9A-DDCD8041EA1F}';
 
type
  itip = interface
  ['{098FB88B-09E0-5a8d-BF9A-DDCD8041EA1F}']
  function dfname:string; stdcall;
  end;
 
type
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.Timer1Timer(Sender: TObject);
var
  tiptip : itip;
  tt: IPersistFile;
  finfo:string;
  pszFileName:PwideChar;
  hr:Hresult;
 
begin
 OleCheck(CoCreateInstance(xCLSID_InfoTip,
                            nil,
                            CLSCTX_ALL,
                            itip,
                            tiptip));
  Form1.Caption := tiptip.dfname;
end;
 
end.

====================================
26  Archived (read-only) / News/Blog / My Experts-Exchange account was suspended today on: May 13, 2009, 05:15:38 PM
Hello Sir Ciuly

>past questions that got accepted later
Yes, I visit your EE profile for many times and found out that you have a new accepted answer:
"04/17/09     500     Best way to access an Oracle…     Assisted     Delphi Programming"

And your Still number 5 in top 25 list on delphi zone.

Your suspension on EE was one of the greatest mistakes of EE.


"EE Delphi Zone misses your presence."


My account was suspended too on: 03/07/09 08:23 AM
Then my account was restored on 04/15/09 07:49 PM with this message "Your account has been reinstated. However, your next violation -- no matter how small or insignificant -- will result in your being permanently barred from using Experts Exchange, and there will be no appeal.


What did I do, to reactivate my account name "rionroc"? Ask me again, lol


Cheers!
Pages: 1 [2]
Powered by MySQL Powered by PHP Powered by SMF 1.1.11 | SMF © 2006-2009, Simple Machines LLC | Sitemap Valid XHTML 1.0! Valid CSS!
Page created in 0.044 seconds with 22 queries.