|
|
 | |  |
|
Статьи Дельфи про Интернет и Сети
Статьи Дельфи про Интернет и Сети
Как получить все Диал-Уп соединения :
____________________________________________________________________
Способ 1 - из реестра:
uses Registry;
function DUNGetConnections(out OutList: TStringList): Boolean;
var Reg: TRegistry;
begin
OutList.Clear;
Reg := TRegistry.Create;
Reg.RootKey := HKEY_CURRENT_USER;
if Reg.OpenKey('\RemoteAccess\Profile', False) then
begin
Reg.GetKeyNames(OutList);
Result := True;
end
else
Result := False;
Reg.Free;
end;
Способ 2 - через RASApi:
Для этого воспользуемся функцией Use RASEnumConnections.
Далее можно определить состояние каждого соединения при помощи RASGetConnectStatus.
Так же можно использовать RASEnumEntries для получения всех сервисов из определённой телефонной книжки.
Толька для этого потребуется преобразовать заголовочный файл RAS.h в эквивалент Delphi.
Как разорвать Диал-Уп соединения :
_______________________________________________________________
type
TRasConn = record
Size: DWORD;
Handle: THandle;
Name: array[0..20] of AnsiChar;
end;
TRasEnumConnections = function(var RasConn: TRasConn; var Size: DWORD;
var Connections: DWORD): DWORD stdcall;
TRasHangUp = function(Handle: THandle): DWORD stdcall;
function DisconnectDialUp: Boolean;
var
Lib: HINST;
RasEnumConnections: TRasEnumConnections;
RasHangUp: TRasHangUp;
RasConn: TRasConn;
Code, Size, Connections: DWORD;
begin
Result := True;
try
Lib := LoadLibrary('rasapi32.dll');
try
if Lib = 0 then
Abort;
RasEnumConnections := GetProcAddress(Lib, 'RasEnumConnectionsA');
if not Assigned(@RasEnumConnections) then
Abort;
RasHangUp := GetProcAddress(Lib, 'RasHangUpA');
if not Assigned(@RasHangUp) then
Abort;
FillChar(RasConn, SizeOf(RasConn), 0);
RasConn.Size := SizeOf(RasConn);
Code := RasEnumConnections(RasConn, Size, Connections);
if (Connections <> 1) or (Code <> 0) then
Abort;
if RasHangUp(RasConn.Handle) <> 0 then
Abort;
Sleep(3000);
finally
FreeLibrary(Lib);
end;
except
on E: EAbort do
Result := False;
else
raise;
end;
end;
Пример использования:
if DisconnectDialUp = true then
ShowMessage('Соединение разорвано')
else
ShowMessage('Не удалось разорвать соединение');
_______________________________________________________________________
Визуальный HTML редактор своими руками :
-----------
Итак, что нам понадобится. В первую очередь - Delphi 5-7 (у меня стоит 7-я версия, и весь код тестировался именно в этой версии). Это вызвано тем, что компонент TWebBrowser впервые "прописался" на вкладке Internet именно в 5-й версии (в 4-й его надо было устанавливать как компонент ActiveX). Еще необходимо, чтобы в системе был установлен Internet Explorer 4 и выше.
Сначала нам надо перевести WebBrowser в режим редактирования. Для этого у каждого документа (согласно объектной модели это document) существует свойство DesignMode. Если установить его в 'On', то наша компонента автоматически переключается в режим редактирования, а если установить его в 'Off', то компонент вернется в режим просмотра.
Проверим это! Создадим новую форму, разместим на ней компоненту TWebBrowser и несколько компонент TSpeedButton. Затем напишем такой код:
unit main;
interface
...
var
Form1: TForm1;
Disp: IDispatch;
Editor: IHTMLDocument2;
implementation
{$R *.dfm}
procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var
CurrentWB: IWebBrowser;
Editor: IHTMLDocument2;
begin
Disp := pDisp;
end;
procedure TForm1.SpeedButton1Click(Sender: TObject);
var
CurrentWB: IWebBrowser;
begin
CurrentWB := Disp as IWebBrowser;
editor := (CurrentWB.Document as IHTMLDocument2);
editor.DesignMode := 'On';
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
WebBrowser1.Navigate('about:<html><body></body></html>');
end;
Теперь по порядку о том, что мы написали. В событии OnCreate формы мы загружаем в браузер простую страницу (напомню, что протокол about: позволяет загружать в браузер HTML строку). Это необходимо для того, чтобы в последующем мы могли обращаться к документу. Сразу после этого будет вызван обработчик события OnDocumentComplete. Но пока еще ничего не произошло. Внимательный читатель мог обратить внимание, что для перевода браузера в режим редактирования надо нажать кнопку 1. Editor - это экземпляр нашего документа (document). Его свойство DesignMode устанавливается в 'On'. Теперь наш редактор практически готов. Он уже умеет править текст, копировать/вырезать/вставлять текст и картинки, делать текст жирным/подчеркнутым/наклонным. Для этого есть соответствующие комбинации клавиш.
Ctrl + C Копировать
Ctrl + X Вырезать
Ctrl + V Вставить
Ctrl + B Жирный текст
Ctrl + I Наклонный текст
Ctrl + U Подчеркнутый текст
Ctrl + Z Отменить
Ctrl + Y Повторить
Ctrl + K Гиперссылка
Ctrl + F Найти
Ctrl + A Выделить всё
Ctrl + Left-Click Выделить блок
"Это, конечно, хорошо, что есть горячие клавиши, но мне не хотелось бы все их запоминать" - можете сказать вы. Хорошо. Тогда давайте разберем, как из Delphi заставить WebBrowser выполнять все эти действия. Для этого есть метод execCommand интерфейса IHTMLTxtRange (он описан в модуле MSHTML_TLB). Рассмотрим простой пример.
procedure TForm1.SpeedButton2Click(Sender: TObject);
var
Range: IHTMLTxtRange;
begin
Range := (editor.selection.createRange as IHTMLTxtRange);
Range.execCommand('bold', false, emptyparam)
end;
Сначала в этой процедуре создается объект Range. После этого вызывается метод execCommand:
function execCommand(cmdID: WideString; ShowUI: WordBool;
Value: OleVariant): wordbool;
cmdID – это строка идентификатор команды (в нашем примере 'bold' заставляет редактор переключаться между жирным и обычным начертанием текста); полный список команд смотри в приложении.
ShowUI – Show User Interface - показывать интерфейс пользователя (если таковой имеется, как правило это различные диалоговые окна). Если параметр равен False, то команда выполняется без предупреждения.
value – содержит дополнительную информацию в зависимости от команды.
Несколько слов об объекте Range. Помимо уже знакомого нам execCommand этот объект обладает еще рядом свойств и методов, некоторые из которых сейчас рассмотрим.
Text - Содержит текст выделения (без тегов HTML)
HTMLText - Полный текст выделения
moveStart(const unit_: widestring; count: integer)
- procedure - Перемещает начальную позицию выделения на count символов вправо (если count<0, то влево), unit_-единицы измерения смещения (чаще всего используется 'character': 1 символ). При этом конечная позиция не смещается.
moveStart(const unit_: widestring; count: integer)
То же самое, только для конечной позиции выделения.
PasteHTML(const html: widestring);
Вставляет HTML-строку
execCommandShowHelp(cmdID: widestring);
Отображает помощь по команде, указанной в cmdID
Пожалуй, на сегодня всё. Об остальных объектах (картинки, таблицы, элементы управления) поговорим в другой раз. Будут вопросы - пишите: mailto:samum2000@mail15.com?subject=Question about visualhtml part1.
Приложение. Доступные команды
BackColor - Устанавливает или получает цвет фона текущего выделения. Value должно содержать имя цвета или его шеснадцитиричный RGB эквивалент (например, #FFCC00).
Bold - Переключает начертание текста текущего выделения между полужирным и нормальным.
Copy - Копирует выделение в буфер обмена
CreateBookmark - Получает имя якоря или создает его для текущего выделения. Value - строка, содержащая имя якоря.
CreateLink - Получает URL ссылки или создает новую ссылку. Параметр Value должен содержать URL.
Cut - Вырезает текущее выделение в буфер обмена.
Delete - Очищает текущее выделение (удаляет всё его содержимое).
Find - Находит текст, заданный в параметре Value в текущем выделении.
FontName - Устанавливает шрифт для текущего выделения. Value содержит описание этого шрифта (как в теге FONT).
FontSize - Устанавливает размер шрифта. Value - число от 1 до 7 включительно.
ForeColor - Устанавливает цвет текста. Value должно содержать имя цвета или его шеснадцитиричный RGB эквивалент (например, #FFCC00)
FormatBlock - Устанавливает или получает форматирование текущего блока. Value может содержать теги-описатели.
Indent - Увеличивает отступ выделенного текста на одну единицу приращения
InsertButton - Перезаписывает идентификатор кнопки вместо текущего выделения. Value - строка, содержащая идентификатор кнопки.
InsertFieldset - То же для поля ввода.
InsertHorizontalRule - То же для горизонтальной полосы.
InsertIFrame - То же для встроеных фреймов (IFRAME).
InsertImage - То же для изображений.
InsertInputButton - То же для кнопки.
InsertInputCheckbox - То же для чекбоксов (checkBox).
InsertInputFileUpload - То же для элемента выбора файла.
InsertInputHidden - То же для скрытого поля (hidden)
InsertInputImage - То же для изображения.
InsertInputPassword - То же для поля ввода пароля.
InsertInputRadio - То же для радио-кнопок (Radio)
InsertInputReset - То же для кнопки reset.
InsertInputSubmit - То же для кнопки Submit.
InsertInputText - То же для поля ввода текста.
InsertParagraph - Вставляет новый раздел (абзац).
InsertOrderedList - Переключает стиль текущего выделения между списком и простым текстом.
InsertUnorderedList - То же самое.
InsertSelectDropdown - Записывает элемент Drop-down вместо текущего выделения. Value должно содержать идентификатор элемента.
InsertTextArea - То же для элемента TextArea.
Italic - Переключает начертание текста текущего выделения между наклонным и обычным.
JustifyCenter - Устанавливает выравнивание по центру для всего блока, в котором расположено текущее выделение.
JustifyLeft - Устанавливает выравнивание по левому краю для всего блока, в котором расположено текущее выделение.
JustifyRight - Устанавливает выравнивание по правому краю для всего блока, в котором расположено текущее выделение.
Outdent - Уменьшает отступ для всего блока, в котором расположено выделение, на одну единицу.
OverWrite - Переключается между режимами вставки текста и замены текста при вводе. Value: true - замена, false - вставка.
Paste - Вставляет текст из буфера обмена вместо текущего выделения.
Refresh - Обновляет текущий документ.
RemoveFormat - Удаляет из текущего фрагмента все теги форматирования
SelectAll - Выделяет все содержимое документа.
UnBookmark - Удаляет все закладки из текущего выделения.
Underline - Переключает начертание текста текущего выделения между подчеркнутым и обычным.
Unlink - Удаляет все гиперссылки из текущего выделенного фрагмента.
Unselect - Снимает выделение.
______________________________________________________________________________
Как получить MAC адрес компьютера :
------------------
uses NB30;
function GetMACAdress: string;
var
NCB: PNCB;
Adapter: PAdapterStatus;
URetCode: PChar;
RetCode: char;
I: integer;
Lenum: PlanaEnum;
_SystemID: string;
TMPSTR: string;
begin
Result := '';
_SystemID := '';
Getmem(NCB, SizeOf(TNCB));
Fillchar(NCB^, SizeOf(TNCB), 0);
Getmem(Lenum, SizeOf(TLanaEnum));
Fillchar(Lenum^, SizeOf(TLanaEnum), 0);
Getmem(Adapter, SizeOf(TAdapterStatus));
Fillchar(Adapter^, SizeOf(TAdapterStatus), 0);
Lenum.Length := chr(0);
NCB.ncb_command := chr(NCBENUM);
NCB.ncb_buffer := Pointer(Lenum);
NCB.ncb_length := SizeOf(Lenum);
RetCode := Netbios(NCB);
i := 0;
repeat
Fillchar(NCB^, SizeOf(TNCB), 0);
Ncb.ncb_command := chr(NCBRESET);
Ncb.ncb_lana_num := lenum.lana[I];
RetCode := Netbios(Ncb);
Fillchar(NCB^, SizeOf(TNCB), 0);
Ncb.ncb_command := chr(NCBASTAT);
Ncb.ncb_lana_num := lenum.lana[I];
// Must be 16
Ncb.ncb_callname := '* ';
Ncb.ncb_buffer := Pointer(Adapter);
Ncb.ncb_length := SizeOf(TAdapterStatus);
RetCode := Netbios(Ncb);
//---- calc _systemId from mac-address[2-5] XOR mac-address[1]...
if (RetCode = chr(0)) or (RetCode = chr(6)) then
begin
_SystemId := IntToHex(Ord(Adapter.adapter_address[0]), 2) + '-' +
IntToHex(Ord(Adapter.adapter_address[1]), 2) + '-' +
IntToHex(Ord(Adapter.adapter_address[2]), 2) + '-' +
IntToHex(Ord(Adapter.adapter_address[3]), 2) + '-' +
IntToHex(Ord(Adapter.adapter_address[4]), 2) + '-' +
IntToHex(Ord(Adapter.adapter_address[5]), 2);
end;
Inc(i);
until (I >= Ord(Lenum.Length)) or (_SystemID <> '00-00-00-00-00-00');
FreeMem(NCB);
FreeMem(Adapter);
FreeMem(Lenum);
GetMacAdress := _SystemID;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
label1.Caption := GetMACAdress;
end;
______________________________________________________________________
Дельфи для качков :
-------------
DownloadFile('http://some.com/some.zip', 'c:\some.zip');
function DownloadFile(const FileURL, FileName: String): Cardinal;
var
hSession, hFile: HInternet;
Buffer: array[1..1024] of Byte;
BufferLen, fSize: LongWord;
f: File;
begin
Result := 0;
hSession := InternetOpen('STEROID Download',
INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
if Assigned(hSession) then begin
hFile := InternetOpenURL(hSession, PChar(FileURL), nil, 0,
INTERNET_FLAG_RELOAD, 0);
if Assigned(hFile) then begin
AssignFile(f, FileName);
Rewrite(f,1);
fSize := 0;
repeat
InternetReadFile(hFile, @Buffer, SizeOf(Buffer), BufferLen);
BlockWrite(f, Buffer, BufferLen);
fSize := fSize + BufferLen;
until (BufferLen = 0);
CloseFile(f);
Result := fSize;
InternetCloseHandle(hFile);
end;
InternetCloseHandle(hSession);
end;
end;
Комментарий:
function InternetOpen(lpszAgent: PChar;
dwAccessType: DWORD;
lpszProxy, lpszProxyBypass: PChar;
dwFlags: DWORD): HINTERNET; stdcall;
lpszAgent - строка символов, которая передается серверу и идентифицирует программное обеспечение, пославшее запрос.
dwAccessType
INTERNET_OPEN_TYPE_DIRECT : обрабатывает все имена хостов локально.
INTERNET_OPEN_TYPE_PRECONFIG : берет установки из реестра.
INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY - берет установки из реестра и предотвращает запуск Jscript или Internet Setup (INS) файлов.
! INTERNET_OPEN_TYPE_PROXY : использование прокси-сервера. В случае неудачи использует INTERNET_OPEN_TYPE_DIRECT.
LpszProxy - адрес прокси-сервера. Игнорируется только если параметр dwAccessType отличается от INTERNET_OPEN_TYPE_PROXY.
LpszProxyBypass - список имен или IP- адресов, соединяться с которыми нужно в обход прокси-сервера. В списке допускаются шаблоны. Так же, как и предыдущий параметр, не может содержать пустой строки. Если dwAccessType отличен от INTERNET_OPEN_TYPE_PROXY, то значения игнорируются, и параметр можно установить в nil.
DwFlags задает параметры, влияющие на поведение Internet- функций. Возможно применение комбинации из следующих разрешенных значений: INTERNET_FLAG_ASYNC, INTERNET_FLAG_FROM_CACHE, INTERNET_FLAG_OFFLINE.
___________________________________________________________________
Посылка файлов через сокет :
----------------
Спать на работе - грех, не для того вам там дан бесплатный интернет!
Здесь мы рассмотрим посылку файлов через сокет. Итак, как же послать файл по сокету? Очень просто! Достаточно лишь открыть этот файл как файловый поток (TFileStream) и отправить его через сокет (SendStream)! Рассмотрим это на примере:
{Посылка файла через сокет}
procedure SendFileBySocket(filename: string);
var
srcfile: TFileStream;
begin
{Открываем файл filename}
srcfile := TFileStream.Create(filename,fmOpenRead);
{Посылаем его первому подключенному клиенту}
ServerSocket1.Socket.Connections[0].SendStream(srcfile);
{Закрываем файл}
srcfile.Free;
end;
Нужно заметить, что метод SendStream используется не только сервером, но и клиентом (ClientSocket1.Socket.SendStream(srcfile))
_____________________________________________________________________________
Как найти все компьютеры в сети :
-----------
unit FindComp;
interface
uses
Windows, Classes;
function FindComputers: DWORD;
var
Computers: TStringList;
implementation
uses
SysUtils;
const
MaxEntries = 250;
function FindComputers: DWORD;
var
EnumWorkGroupHandle, EnumComputerHandle: THandle;
EnumError: DWORD;
Network: TNetResource;
WorkGroupEntries, ComputerEntries: DWORD;
EnumWorkGroupBuffer, EnumComputerBuffer: array[1..MaxEntries] of TNetResource;
EnumBufferLength: DWORD;
I, J: DWORD;
begin
Computers.Clear;
FillChar(Network, SizeOf(Network), 0);
with Network do
begin
dwScope := RESOURCE_GLOBALNET;
dwType := RESOURCETYPE_ANY;
dwUsage := RESOURCEUSAGE_CONTAINER;
end;
EnumError := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0, @Network,
EnumWorkGroupHandle);
if EnumError = NO_ERROR then
begin
WorkGroupEntries := MaxEntries;
EnumBufferLength := SizeOf(EnumWorkGroupBuffer);
EnumError := WNetEnumResource(EnumWorkGroupHandle, WorkGroupEntries,
@EnumWorkGroupBuffer, EnumBufferLength);
if EnumError = NO_ERROR then
begin
for I := 1 to WorkGroupEntries do
begin
EnumError := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0,
@EnumWorkGroupBuffer[I], EnumComputerHandle);
if EnumError = NO_ERROR then
begin
ComputerEntries := MaxEntries;
EnumBufferLength := SizeOf(EnumComputerBuffer);
EnumError := WNetEnumResource(EnumComputerHandle, ComputerEntries,
@EnumComputerBuffer, EnumBufferLength);
if EnumError = NO_ERROR then
for J := 1 to ComputerEntries do
Computers.Add(Copy(EnumComputerBuffer[J].lpRemoteName, 3,
Length(EnumComputerBuffer[J].lpRemoteName) - 2));
WNetCloseEnum(EnumComputerHandle);
end;
end;
end;
WNetCloseEnum(EnumWorkGroupHandle);
end;
if EnumError = ERROR_NO_MORE_ITEMS then
EnumError := NO_ERROR;
Result := EnumError;
end;
initialization
Computers := TStringList.Create;
finalization
Computers.Free;
end.
|
| Категория: DELPHI | Добавил: SeM (02.04.2011)
|
| Просмотров: 887
| Рейтинг: 0.0/0 |
Добавлять комментарии могут только зарегистрированные пользователи. [ Регистрация | Вход ] | |
 | |  |
|
 |
| Коменнтарии
 | |
Извиняюсь, заработал. Спасибо за урок 
Давайте помогу разобраться ? вы хотите что бы когда выбиралась станция сразу начинала проигрывать? скиньте исходник или как лучше связаться с вами?
Нифига не робит...
Кто знает как сделать чтобы на жесткий жертвы сохранял..
ISQ 606017777
|
 |
|
| Отзывы Фото
| |
6 микр. Красивое место....
Старый музей но щас его перенесли...
Фотография под горы 
Красивое фото!!!
|
|
|
