Форум программистов
 
Контакты: о проблемах с регистрацией, почтой и по другим вопросам пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail.

Вернуться   Форум программистов > Delphi > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Ответ
 
Опции темы
Старый 20.06.2018, 16:21   #21
Баламут
Баламучу слегка...
СуперМодератор
 
Аватар для Баламут
 
Регистрация: 01.11.2006
Адрес: Владивосток
Сообщений: 1,532
Репутация: 1059
По умолчанию

Нет, ну я писал для себя что-то вроде этого. Но в данном случае опять же библиотеки от джедаев. Хоотя вроде где-то был и свой вариант именно для этих целей. Пороюсь. Пока так:

Код:

unit Connect;

interface

uses Windows, SysUtils, jwaWinNetWK, jwaLMUse, jwaLMAPIBuf, jwaLMUseFlg, Classes;

type
  TInfo = array[0..0] of _USE_INFO_0;
  PInfo = ^TInfo;

  TConData = record
    RemoteName: string;
    LocalName:  string;
  end;

type
TConnections = class(TObject)
    destructor Destroy; override;
private
//  FPath:        WideString;
  FNetRes:      NETRESOURCE;
  FdwStatus:    cardinal;
  FMachineName: PWideChar;
  FUserName:    PWideChar;
  FPassword:    PWideChar;
  FErrorCode:   cardinal;
  FCount: cardinal;
  FErrorString: string;
  FConArray: array of TConData;
  FForce: boolean;

  function GetMachineName: string;
  function GetCon(n: integer): TConData;
  procedure SetMachineName(aName: string);

public
  procedure EnumConnections;
  property MachineName: string read GetMachineName write SetMachineName;
  property Count: cardinal read FCount;
  property ErrorCode: cardinal read FErrorCode;
  property ErrorString: string read FErrorString;
  property Connections [aIndex: integer]: TConData read GetCon;
  property Force: boolean read FForce write FForce;
  procedure DeleteConnect(LocalName, RemoteName: WideString);
end;

implementation

{ TConnections }

procedure TConnections.DeleteConnect(LocalName, RemoteName: WideString);
var
  Force: DWORD;
  Err:   DWORD;
begin
  FErrorCode := NO_ERROR;
  if FForce then Force := USE_LOTS_OF_FORCE
  else Force := USE_NOFORCE;
  if LocalName = '' then Err := NetUseDel(nil, PWideChar(RemoteName), Force)
  else Err := WNetCancelConnection(PWideChar(LocalName), FForce);

  if Err <> NO_ERROR then
  begin
    FErrorCode := Err;
    FErrorString := SysErrorMessage(FErrorCode);
  end;
end;

destructor TConnections.Destroy;
begin
  SetLength(FConArray, 0);
  inherited;
end;

procedure TConnections.EnumConnections;
var
  Count: cardinal;
  TotalCount: cardinal;
  Buf: PByte;
  i: integer;
begin
  FdwStatus := NetUseEnum(nil,
                          0,
                          Buf,
                          255,
                          @Count,
                          @TotalCount,
                          nil);
  if Count = 0 then Exit;
  SetLength(FConArray, Count);
  FCount := Count;
  for i := 0 to Count - 1 do
  begin
    FConArray[i].RemoteName := PInfo(Buf)^[i].ui0_remote;
    FConArray[i].LocalName  := PInfo(Buf)^[i].ui0_local;
  end;
end;

function TConnections.GetCon(n: integer): TConData;
begin
  Result := FConArray[n];
end;

function TConnections.GetMachineName: string;
begin
  Result := FMachineName;
end;

procedure TConnections.SetMachineName(aName: string);
begin
  FMachineName := PWideChar(aName);
end;

end.

Баламут на форуме   Ответить с цитированием
Ответ

Опции темы

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Рекурсивный поиск файлов. Pein95 Общие вопросы C/C++ 2 20.10.2013 02:00
Рекурсивный поиск минимума в массиве Михаил Роганин Помощь студентам 4 17.01.2012 14:30
рекурсивный поиск с возвратом mego4el Помощь студентам 0 25.04.2011 22:45
Рекурсивный поиск zumm Общие вопросы Delphi 7 01.11.2010 23:47
Рекурсивный поиск папок FindFirst Lehanidze Помощь студентам 4 06.08.2009 13:13


06:41.


Powered by vBulletin® Version 3.8.8 Beta 2
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.

RusProfile.ru


Справочник российских юридических лиц и организаций.
Проекты отопления, пеллетные котлы, бойлеры, радиаторы
интернет магазин respective.ru