Как запустить создание письма по указанному адресу?
Как запустить браузер по http-адресу?
Перехват меню IE ( TWebBrowser ) и подмена его собственным PopupMenu
Преобразование IPAddres(LongInt) в привычное xxx.xxx.xxx.xxx
Получить список компьютеров, подключенных к сети.
Сканирование доменов
Получение IP-адреса и маски для всех сетевых интерфейсов.
Как узнать свой IP
Как определить машина в сети
Как при помощи Api отправить письмо
Как определить под каким именем расшарена папка

Преобразование IPAddres(LongInt) в привычное xxx.xxx.xxx.xxx
Обязательно указывать в uses модуль WinSock......

function Ip2String(Ip_address:longint):string;
begin
  ip_address:=winsock.ntohl(ip_address);
  result:= inttostr(ip_address shr 24)+'.'+
           inttostr((ip_address shr 16) and $ff)+'.'+
           inttostr((ip_address shr 8) and $ff)+'.'+
           inttostr(ip_address and $ff);
 

В части преобразования IP адреса в строку, автор пошел по пути изобретения велосипеда. В winsock уже есть специальные функции для преобразования адресов.

function inet_ntoa(inaddr: TInAddr): PChar;
{Функция предназначена для получения строкового представления IP адреса в
формате (a.b.c.d).}
var
    s : string;
    L : longint;
.....
 L := 12345678;
 s := inet_ntoa( TInAddr(L));
.....


function inet_addr(cp: PChar): u_long; stdcall;
Функция предназначена для получения двоичного IP адреса из его строкового
представления (в любом виде, допустимом для IP адресов).
var
    s : string;
    l : longint;
...
 s := '127.0.0.1';
 l := inet_addr( PChar(s));
...

Вернуться к содержанию

1.Получить список компьютеров, подключенных к сети.
Перенесено в Сокровищницу из Круглого Стола.

unit NetUtils;
interface
uses Windows, Classes;
function GetContainerList(ListRoot:PNetResource):TList; Type
  {$H+}
   PNetRes = ^TNetRes;
   TNetRes = Record
             dwScope       : Integer;
             dwType        : Integer;
             dwDisplayType : Integer;
             dwUsage       : Integer;
             LocalName     : String;
             RemoteName    : String;
             Comment       : String;
             Provider      : String;
           End;
  {H-}

implementation
uses SysUtils;
 type
 PnetResourceArr = ^TNetResource; {TNetResource - это запись,
                      эквивалентная TNetRes, за исключением того, что
                      вместо типов string там типы PChar. }

 function GetContainerList(ListRoot:PNetResource):TList;
{возвращает список сетевых имён с подуровня ListRoot, каждый
элемент списка TList - это PNetRes, где поле RemoteName определяет
соответственно сетевое имя элемента списка. Если ListRoot=nil, то
возвращается самый верхний уровень типа:
1. Microsoft Windows Network
2. Novell Netware Network
Чтобы получить список доменов/рабочих групп сети Microsoft, нужно
вызвать эту функцию второй раз, передав ей в качестве параметра,
соответствующий элемент списка, полученного при первом её вызове.
Чтобы получить список компьютеров домена - вызвать третий раз...}
{Единственное, я не знаю как узнать имя текущего домена.}
Var
  TempRec     : PNetRes;
  Buf         : Pointer;
  Count,
  BufSize,
  Res         : DWORD;
  lphEnum     : THandle;
  p           : PNetResourceArr;
  i           : SmallInt;
  NetworkList : TList;
Begin
  NetworkList := TList.Create;
  Result:=nil;
  BufSize := 8192;
  GetMem(Buf, BufSize);
  Try
    Res := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK,
RESOURCEUSAGE_CONTAINER{0}, ListRoot,lphEnum);
    {в результате получаем ссылку lphEnum}
    If Res <> 0 Then Raise Exception(Res);
    Count := $FFFFFFFF; {требуем выдать столько записей в
список, сколько есть}
    Res := WNetEnumResource(lphEnum, Count, Buf, BufSize); {в буфере Buf - списочек
                         в виде массива указателей на структуры типа TNetResourceArr
                         а в Count - число этих структур}
    If Res = ERROR_NO_MORE_ITEMS Then Exit;
    If (Res <> 0) Then Raise Exception(Res);
    P := PNetResourceArr(Buf);
    For I := 0 To Count - 1 Do
    Begin                   //Требуется копирование из буфера, так как он
      New(TempRec);         //действителен только до следующего  вызова функций группы
WNet
      TempRec^.dwScope := P^.dwScope;
      TempRec^.dwType := P^.dwType ;
      TempRec^.dwDisplayType := P^.dwDisplayType ;
      TempRec^.dwUsage := P^.dwUsage ;
      TempRec^.LocalName := StrPas(P^.lpLocalName);  {имеются  ввиду вот эти указатели}
      TempRec^.RemoteName := StrPas(P^.lpRemoteName); {в смысле  - строки PChar}
      TempRec^.Comment := StrPas(P^.lpComment);
      TempRec^.Provider := StrPas(P^.lpProvider);
      NetworkList.Add(TempRec);
      Inc(P);
    End;
    Res := WNetCloseEnum(lphEnum);
    {а следующий вызов - вот он!}
    If Res <> 0 Then Raise Exception(Res);
    Result:=NetWorkList;
    Finally
      FreeMem(Buf);
  End;
End;
end.

Пример:

uses NetUtils;
var
 List:TList;
begin
 List:=TList.Create;
 List:=GetContainerList(nil); // Получили список сетей.
                             //  Как правило первая - сеть Microsoft
 List:=GetContainerList(List[0]); //Получаем список доменов сети
 for i:=0 to List.Count-1 do
   if PNetRes(List[i])^.RemoteName='YourDomain' then
     begin
     List:=GetContainerList(List[i]);
     Break;
     end;
 // теперь в List - список включённых компьютеров
 // в домене/рабочей группе YourDomain. Каждый элемент списка имеет
 // тип PNetRes. Само имя компьютера можно получить List[i])^.RemoteName
 for i := 0 to List.Count-1 do
  writeln(PNetRes(List[i])^.RemoteName);
end.

Вернуться к содержанию

1.Сканирование доменов
Переменная List заполняется списком доменов. Функция возвращает код ошибки обращения к сети.

Function FillNetLevel(xxx: PNetResource; list: TStrings) : Word;
Type
    PNRArr = ^TNRArr;
    TNRArr = array[0..59] of TNetResource;
Var
   x: PNRArr;
   tnr: TNetResource;
   I : integer;
   EntrReq,
   SizeReq,
   twx: Integer;
   WSName: string;
begin
     Result := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY,
                                RESOURCEUSAGE_CONTAINER, xxx, twx);
     If Result = ERROR_NO_NETWORK Then Exit;
     if Result = NO_ERROR then
     begin
            New(x);
            EntrReq := 1;
            SizeReq := SizeOf(TNetResource)*59;
            while (twx <> 0) and 
                  (WNetEnumResource(twx, EntrReq, x, SizeReq) <> ERROR_NO_MORE_ITEMS) do
            begin
                  For i := 0 To EntrReq - 1 do
                  begin
                   Move(x^[i], tnr, SizeOf(tnr));
                   case tnr.dwDisplayType of
                    RESOURCEDISPLAYTYPE_DOMAIN:
                    begin
                       if tnr.lpRemoteName <> '' then
                           WSName:= tnr.lpRemoteName
                           else WSName:= tnr.lpComment;
                       list.Add(WSName);
                    end;
                    else FillNetLevel(@tnr, list);
                   end;
                  end;
            end;
            Dispose(x);
            WNetCloseEnum(twx);
     end;
end;

Вернуться к содержанию

Как запустить создание письма по указанному адресу?
Сначала необходимо написать в разделе uses ShellAPI.
ShellExecute(Application.Handle,'open','mailto:towho@mysite.com',nil,nil,0);

Как запустить браузер по http-адресу?
Сначала необходимо написать в разделе uses ShellAPI.
ShellExecute(Application.Handle,'open','http://mysite.com,nil,nil,0);

Перехват меню IE ( TWebBrowser ) и подмена его собственным .

Модуль просто подключается к проекту.
 

unit WbPopup;

interface

// Для преобразования кликов правой кнопкой в клики левой, раскомментировать
// {$DEFINE __R_TO_L}

implementation

uses Windows,Controls,Messages,ShDocVw;

var
  HMouseHook:THandle;

function MouseProc(
    nCode: Integer;     // hook code
    WP: wParam; // message identifier
    LP: lParam  // mouse coordinates
   ):Integer;stdcall;
var MHS:TMOUSEHOOKSTRUCT;
    WC:TWinControl;
{$ifdef __R_TO_L}
    P:TPoint;
{$endif}
begin
  Result:=CallNextHookEx(HMouseHook,nCode,WP,LP);
  if nCode=HC_ACTION then
   begin
     MHS:=PMOUSEHOOKSTRUCT(LP)^;
     if ((WP=WM_RBUTTONDOWN) or (WP=WM_RBUTTONUP)) then
      begin
        WC:=FindVCLWindow(MHS.pt);
        if (WC is TWebBrowser) then
        begin
          Result:=1;
{$ifdef __R_TO_L}
          P:=WC.ScreenToClient(MHS.pt);
          if WP=WM_RBUTTONDOWN
          then PostMessage(MHS.hwnd,WM_LBUTTONDOWN,0,P.x + P.y shl 16);

          if WP=WM_RBUTTONUP
          then PostMessage(MHS.hwnd,WM_LBUTTONUP,0,P.x + P.y shl 16);
{$endif}
          if (TWebBrowser(WC).PopupMenu<>nil) and (WP=WM_RBUTTONUP) then
           begin
            TWebBrowser(WC).PopupMenu.PopupComponent:=WC;
            TWebBrowser(WC).PopupMenu.Popup(MHS.pt.x,MHS.pt.y);
           end;
        end;
      end;
   end;
end;

initialization
 

HMouseHook:=SetWindowsHookEx(WH_MOUSE,@MouseProc,HInstance,GetCurrentThreadID);

finalization

  CloseHandle(HMouseHook);

end.
 
 
57