ANTICHAT.XYZ    VIDEO.ANTICHAT.XYZ    НОВЫЕ СООБЩЕНИЯ    ФОРУМ  
Баннер 1   Баннер 2
Antichat снова доступен.
Форум Antichat (Античат) возвращается и снова открыт для пользователей. Здесь обсуждаются безопасность, программирование, технологии и многое другое. Сообщество снова собирается вместе.
Новый адрес: forum.antichat.xyz
Вернуться   Форум АНТИЧАТ > Программирование > С/С++, C#, Delphi, .NET, Asm
Перезагрузить страницу Почти все о работе с сетью
   
Ответ
 
Опции темы Поиск в этой теме Опции просмотра

Почти все о работе с сетью
  #1  
Старый 30.03.2007, 18:44
Аватар для Ch3ck
Ch3ck
Познавший АНТИЧАТ
Регистрация: 09.06.2006
Сообщений: 1,359
Провел на форуме:
5301021

Репутация: 1879


По умолчанию Почти все о работе с сетью
Вообщем щас нашёл .doc документ у себя на компе... а там такое:
Почти все о работе с сетью.

Предисловие

Часто возникают вопросы по работе с сетью, и конечно, часто возникают ответы. Но так как многим лень пользоваться поиском или глянуть FAQ, то в этой статье я попробую как можно полнее и понятнее собрать материал, найденный мною.

Для начала про FTP:

Приведенная функция скачивает файл по ftp и при этом отображает прогресс скачивания.
Передаются параметры: Хост, с которого качаем; Имя пользователя; Пароль; Порт; Директория файла; Имя файла; Имя полосы отображения прогресса.
Код:
{ 
  The following function shows how to connect to a ftp server 
  and download a file. 
  It uses the functions from wininet.dll. 
  You need a ProgressBar to show the progress and a Label to show progress informations. 
} 
uses 
  WinInet, ComCtrls; 
function FtpDownloadFile(strHost, strUser, strPwd: string; 
  Port: Integer; ftpDir, ftpFile, TargetFile: string; ProgressBar: TProgressBar): Boolean; 
  function FmtFileSize(Size: Integer): string; 
  begin 
	if Size >= $F4240 then 
	  Result := Format('%.2f', [Size / $F4240]) + ' Mb' 
	else 
	if Size < 1000 then 
	  Result := IntToStr(Size) + ' bytes' 
	else 
	  Result := Format('%.2f', [Size / 1000]) + ' Kb'; 
  end; 
const 
  READ_BUFFERSIZE = 4096;  // or 256, 512, ... 
var 
  hNet, hFTP, hFile: HINTERNET; 
  buffer: array[0..READ_BUFFERSIZE - 1] of Char; 
  bufsize, dwBytesRead, fileSize: DWORD; 
  sRec: TWin32FindData; 
  strStatus: string; 
  LocalFile: file; 
  bSuccess: Boolean; 
begin 
  Result := False; 
  { Open an internet session } 
  hNet := InternetOpen('Program_Name', // Agent 
						INTERNET_OPEN_TYPE_PRECONFIG, // AccessType 
						nil,  // ProxyName 
						nil, // ProxyBypass 
						0); // or INTERNET_FLAG_ASYNC / INTERNET_FLAG_OFFLINE 
  { 
	Agent contains the name of the application or 
	entity calling the Internet functions 
  } 
  { See if connection handle is valid } 
  if hNet = nil then 
  begin 
	ShowMessage('Unable to get access to WinInet.Dll'); 
	Exit; 
  end; 
  { Connect to the FTP Server } 
  hFTP := InternetConnect(hNet, // Handle from InternetOpen 
						  PChar(strHost), // FTP server 
						  port, // (INTERNET_DEFAULT_FTP_PORT), 
						  PChar(StrUser), // username 
						  PChar(strPwd),  // password 
						  INTERNET_SERVICE_FTP, // FTP, HTTP, or Gopher? 
						  0, // flag: 0 or INTERNET_FLAG_PASSIVE 
						  0);// User defined number for callback 
  if hFTP = nil then 
  begin 
	InternetCloseHandle(hNet); 
	ShowMessage(Format('Host "%s" is not available',[strHost])); 
	Exit; 
  end; 
  { Change directory } 
  bSuccess := FtpSetCurrentDirectory(hFTP, PChar(ftpDir)); 
  if not bSuccess then 
  begin 
	InternetCloseHandle(hFTP); 
	InternetCloseHandle(hNet); 
	ShowMessage(Format('Cannot set directory to %s.',[ftpDir])); 
	Exit; 
  end; 
  { Read size of file } 
  if FtpFindFirstFile(hFTP, PChar(ftpFile), sRec, 0, 0) <> nil then 
  begin 
	fileSize := sRec.nFileSizeLow; 
	// fileLastWritetime := sRec.lastWriteTime 
  end else 
  begin 
	InternetCloseHandle(hFTP); 
	InternetCloseHandle(hNet); 
	ShowMessage(Format('Cannot find file ',[ftpFile])); 
	Exit; 
  end; 
  { Open the file } 
  hFile := FtpOpenFile(hFTP, // Handle to the ftp session 
					   PChar(ftpFile), // filename 
					   GENERIC_READ, // dwAccess 
					   FTP_TRANSFER_TYPE_BINARY, // dwFlags 
					   0); // This is the context used for callbacks. 
  if hFile = nil then 
  begin 
	InternetCloseHandle(hFTP); 
	InternetCloseHandle(hNet); 
	Exit; 
  end; 
  { Create a new local file } 
  AssignFile(LocalFile, TargetFile); 
  {$i-} 
  Rewrite(LocalFile, 1); 
  {$i+} 
  if IOResult <> 0 then 
  begin 
	InternetCloseHandle(hFile); 
	InternetCloseHandle(hFTP); 
	InternetCloseHandle(hNet); 
	Exit; 
  end; 
  dwBytesRead := 0; 
  bufsize := READ_BUFFERSIZE; 
  while (bufsize > 0) do 
  begin 
	Application.ProcessMessages; 
	if not InternetReadFile(hFile, 
							@buffer, // address of a buffer that receives the data 
							READ_BUFFERSIZE, // number of bytes to read from the file 
							bufsize) then Break; // receives the actual number of bytes read 
	if (bufsize > 0) and (bufsize <= READ_BUFFERSIZE) then 
	  BlockWrite(LocalFile, buffer, bufsize); 
	dwBytesRead := dwBytesRead + bufsize; 
	{ Show Progress } 
	ProgressBar.Position := Round(dwBytesRead * 100 / fileSize); 
	Form1.Label1.Caption := Format('%s of %s / %d %%',[FmtFileSize(dwBytesRead),FmtFileSize(fileSize) ,ProgressBar.Position]); 
  end; 
  CloseFile(LocalFile); 
  InternetCloseHandle(hFile); 
  InternetCloseHandle(hFTP); 
  InternetCloseHandle(hNet); 
  Result := True; 
end;
Про E-Mail:

Отправляем письмо из почтового клиента, используемого по умолчанию:
Код:
uses SHELLAPI;
procedure AutoSendMail;
var
  EMailDestinationString, SubjectString, Line1String,
	Line2String, mailstring: string;
begin
  EMailDestinationString := 'gbamber@bamber.com';
  SubjectString := 'Message Subject';
  Line1String := 'This is the first line';
  Line2String := 'This is the second line';
  // Можно использовать несколько адресов, разделяя их точкой с запятой
  mailstring := 'mailto:' + EMailDestinationString +
	'?subject=' + SubjectString +
	'&body=' + Line1String +
	'%0d' + Line2String;
  if (ShellExecute(0, 'open', PChar(mailstring), '', '',
	SW_SHOWNORMAL) <= 32) then
	ShowMessage('Auto method failed.');
end;
Пишем письмо незаметно от пользователя по протоколу SMTP:
Код:
{
smtp - ip адрес smtp сервера
port - порт smtp сервера, по умолчанию 25
from - адрес отправителя
dest - адрес получателя
subject - тема письма
body - текст писма
Возвращает True если письмо было успешно отправленно...
}
function mail(smtp: string; port: integer; from, dest, subject,
  body: string): bool;
const
  cl = #13#10;
var
WSAData: TWSAData;
  Host: TSockAddrIn;
  Sock: TSocket;
  res: Integer;
  buff: array[1..255] of Char;
  { отправляем данные через сокет }
  procedure senddata(str: string);
  var
	i: integer;
  begin
	for i := 1 to Length(str) do
	  if send(Sock, str[i], 1, 0) = SOCKET_ERROR then
		exit;
  end;
  { получаем ответ от команды }
  function recvdata(accept: string): bool;
  var
	buff: array[1..255] of Char;
  begin
	res := recv(Sock, buff, SizeOf(buff), 0);
	Result := (Res = SOCKET_ERROR) or (Copy(buff, 1, 3) = accept);
  end;
begin
  try
	result := false;
	{ инициализация сокета }
	WSAStartUp(257, WSAData);
	Sock := socket(AF_INET, SOCK_STREAM, IPPROTO_IP);
	if Sock = INVALID_SOCKET then
	  Exit;
	{ устанавливаем хост и порт сервера }
	res := inet_addr(PChar(smtp));
	if res <= 0 then
	  exit;
	Host.sin_family := AF_INET;
	Host.sin_port := htons(port);
	Host.sin_addr.S_addr := res;
	{ подключаемся к серверу }
	if connect(Sock, Host, SizeOf(Host)) > 0 then
	  Exit;
	{ приветствие сервера }
	if not recvdata('220') then
	  Exit;
	{ EHLO }
	senddata('EHLO' + cl);
	if not recvdata('250') then
	  Exit;
	{ MAIL FROM: }
	senddata('MAIL FROM:' + from + cl);
	if not recvdata('250') then
	  Exit;
	{ RCPT TO: }
	senddata('RCPT TO:' + dest + cl);
	if not recvdata('250') then
	  Exit;
	{ DATA }
	senddata('DATA' + cl);
	if not recvdata('354') then
	  Exit;
	{ отправляем текст сообщения }
	senddata('Subject:' + subject + cl + cl + body + cl + '.');
	if not recvdata('250') then
	  Exit;
	{ отключаемся от сервера }
	senddata('QUIT' + cl);
	result := true;
  finally
	{ убиваем сокет }
	closesocket(sock);
	WSACleanup;
  end;
end;
{
mail('127.0.0.1',25,'bboy-ne@yandex.ru' ,'admin@company.mail', 'subj', 'body text');
}
TCP-IP

Свой IP:
Код:
uses
  WinSock;
function GetLocalIP: String;
const WSVer = $101;
var
  wsaData: TWSAData;
  P: PHostEnt;
  Buf: array [0..127] of Char;
begin
  Result := '';
  if WSAStartup(WSVer, wsaData) = 0 then begin
	if GetHostName(@Buf, 128) = 0 then begin
	  P := GetHostByName(@Buf);
	  if P <> nil then Result := iNet_ntoa(PInAddr(p^.h_addr_list^)^);
	end;
	WSACleanup;
  end;
end;

Получаем IP из Host:
Код:
uses
  WinSock;
const
  WINSOCK_VERSION = $0101;
function GetIPAddress(name: string): string;
var
  WSAData: TWSAData;
  p: PHostEnt;
begin
  WSAStartup(WINSOCK_VERSION, WSAData);
  p := GetHostByName(PChar(name));
  Result := inet_ntoa(PInAddr(p.h_addr_list^)^);
  WSACleanup;
end;
Или так:
Код:
function HostToIP(Name: string): String;
var
 wsdata : TWSAData;
 hostName: array [0..255] of char;
 hostEnt : PHostEnt;
 addr : PChar;
begin
 Result:= '';
 WSAStartup($0101, wsdata);
 try
   GetHostName(HostName, SizeOf(hostName));
   StrPCopy(hostName, Name);
   hostEnt:= gethostbyname(hostName);
   if not Assigned(hostEnt			 ) then Exit;
   if not Assigned(hostEnt^.h_addr_list) then exit;
   addr:= hostEnt^.h_addr_list^;
   if not Assigned(addr				) then Exit;
   Result:= Format('%d.%d.%d.%d', [Ord(addr[0]), Ord(addr[1]), Ord(addr[2]), Ord(addr[3])]);
 finally
   WSACleanup;
 end
end;

Если кто-то работает с Telnet:
Код:
создание файлового архива	tar, cpio
архивация файла	compress, pack
замер времени исполнения команды	time, timex
запуск программы в указанное время	at
вывод файла на экран	cat, page, dtpad, textedit. xedit
постраничный вывод файла на экран	more
вывод на экран первых десяти строк файла	head
вывод на экран последних десяти строк файла	tail
вывод содержимого заархивированного файла	peat
выполнение вычислений	be, dc
вывод даты и времени	date
изменение даты модификации файла на текущую	touch
деархивация файла	unpack, uncompress
декодирование UU-кода	uudecode
вывод объема свободного дискового пространства	df
вывод объема дискового пространства,	 
занятого данным каталогом	du
завершение работы	exit
печать заголовка	banner
захват изображения на экране	xv, xwd
печать изображений	xdpr, xpr
вывод имени системы	uname
запуск интерпретатора командной строки	sh, csh, ksh
запуск интерпретатора командной строки на удаленной системе	rsh
личный календарь	cm, dtcm
вывод календаря	cal, cm, dtcm
калькулятор	calctool, dtcalc, xcalc
создание каталога	mkdir, filemgr dtfile
вывод размера каталога	du
вывод списка файлов и подкаталогов данного каталога	Is
смена текущего каталога	cd
удаление каталога	rmdir, filemgr, dtfile
вывод имени текущего каталога	pwd
сравнение содержимого двух каталогов	dircmp
UU-кодирование файла для пересылки его по электронной почте	uuencode
выполнение команды в указанное время	at
ввод команды при работе с графическим интерфейсом	xterm, dtterm, shelltool
компиляция С-программ, копирование файлов	cat, cp, filemgr, dtfile
копирование файлов на удаленную систему и с удаленной системы	гср
копирование файлов между UNIX-системами	uucp
вычисление контрольной суммы файла	sum
нумерация строк текстового файла	n1
объединение нескольких файлов в один	cat
объединение отсортированных файлов по общему полю	join
объединение файлов в качестве двух столбцов	paste
вывод или установка значений переменных окружения	env
ожидание завершения процесса	wait
отправка сообщения другому пользователю	write
очистка экрана	clear
вывод состояния службы печати	Ipstat
запуск службы печати	Ipsched
останов службы печати	Ipshut
печать заголовка	banner
персональный календарь	calendar, cm, dtcm
подсчет количества слов в текстовом файле	we
выполнение повторяющихся задач	crontab
поиск текстовых строк	egrep, grep, fgrep
поиск и замена символов	tr
поиск в файле	awk, nawk
поиск файлов	find
вывод списка пользователей	listusers
вывод информации о других пользователях системы	who
поиск информации о других пользователях системы	finger
выполнение последовательности команд	batch
запуск команды с пониженным приоритетом	nice
проверка правописания	spell
прерывание процесса	kill
вывод списка процессов	PS
присоединение содержимого файлов к существующему файлу	cat
разбиение файла на части	csplit, split
редактирование текстового файла	vi, ed, dtpad, textedit,
	xedit
резервирование информации	tar, cpio
поиск и замена символов	tr
вывод списка известных систем	uuname
вывод системного идентификатора пользователя	id
вывод системных сообщений	news
подсчет числа слов в файле	we
вывод состояния службы UUCP	uustat
создание нового текстового файла	cat, dtpad, textedit,
	xedit
установка соединения с удаленным	 
терминалом	ct
установка соединения с удаленной	 
UNIX-системой	cu
разрешение/запрет вывода сообщений на	 
терминал	mesg
вывод сообщений	news
сортировка файла	sort
сортировка и обработка файла	awk, nawk
вывод состояния машин в сети	ruptime
вывод списка файлов в каталоге	Is
сравнение содержимого двух каталогов	dircmp
сравнение содержимого двух отсортированных файлов	comm
сравнение трех файлов	diff3
сравнение двух файлов и вывод отличающихся строк	diff, bdiff
сравнение двух файлов	cmp
сравнение двух файлов и вывод	 
отличающихся и совпадающих строк	sdiff
создание ссылок	In
печать на стандартный вывод	echo
запись стандартного вывода в файл	tee
вывод столбца из отсортированного файла	cut
поиск текстовых строк в бинарном файле	strings
поиск текстовых строк	egrep, grep, fgrep
табличный процессор	tbi
настройка табуляции	tabs
смена текущего каталога	cd
вывод имени текущего каталога	pwd
открытие окна терминала	xterm,
	dtterm,
	shelltool
вывод информации о терминале	tput
настройка конфигурации терминала	stty
вывод параметров терминала	tty
определение типа файла	file
удаление из очереди заданий, созданных	 
командой at	atrm
удаление заданий из очереди печати	cancel
удаление каталога	rmdir,
	filemgr,
	dtfile
удаление файла	rm, filemgr,
	dtfile
удаление форматирующих символов	 
из файла	col
копирование файлов с удаленной системы	rep, uucp,
	ftp
выполнение команды на удаленной системе	uux
запуск интерпретатора командной строки на	 
удаленной системе	rsh
вход в удаленную систему	telnet,
	riogin
вывод информации о соединениях с	 
удаленными системами	uulog
создание нового текстового файла	cat, dtpad,
	textedit,
	xedit
изменение даты модификации файла на	 
текущую	touch
вывод полного имени файла	basename
вывод файла на экран	cat, page, dtpad, textedit, xedit
постраничный вывод файла на экран	more
вывод на экран первых десяти строк файла	head
вывод на экран последних десяти строк файла	tail
вывод списка файлов в каталоге	Is
копирование файла	cat, cp, filemgr, dtfile
определение типа файла	file
поиск файла	find
разбиение файла	split
редактирование файла	vi, ed, dtpad. textedit, xedit
удаление файла	rm
шифрование файла	crypt
печать формул	eqn, neqn
отображение шрифта	xfd, xfontsel
вывод списка доступных шрифтов	xlsfonts, fslsfonts
отправка и чтение электронной почты	mailx, dtmail, mailtool
уведомление о получении новых писем по электронной почте	notify, xbiff

Проверяем, есть-ли URL:
Код:
uses wininet;
function CheckUrl(url: string): boolean;
var
  hSession, hfile, hRequest: hInternet;
  dwindex, dwcodelen: dword;
  dwcode: array [1..20] of char;
  res: pchar;
begin
  if pos('http://', lowercase(url)) = 0 then
	url := 'http://'+url;
  Result := false;
  hSession := InternetOpen('InetURL:/1.0', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  if assigned(hsession) then
  begin
	hfile := InternetOpenUrl(hsession, pchar(url), nil, 0, INTERNET_FLAG_RELOAD, 0);
	dwIndex := 0;
	dwCodeLen := 10;
	HttpQueryInfo(hfile, HTTP_QUERY_STATUS_CODE, @dwcode, dwcodeLen, dwIndex);
	res := pchar(@dwcode);
	result := (res = '200') or (res = '302');
	if assigned(hfile) then
	  InternetCloseHandle(hfile);
	InternetCloseHandle(hsession);
  end;
end;

Dial-Up соединения:
Разорвать соединение:
Код:
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('Не удалось разорвать соединение');
Набрать номер модемом
Код:
var
  hCommFile: THandle;
procedure TForm1.Button1Click(Sender: TObject);
var
  PhoneNumber: string;
  CommPort: string;
  NumberWritten: LongInt;
begin
  PhoneNumber := 'ATDT 1-555-555-1212' + #13 + #10;
  CommPort := 'COM2';
  {Open the comm port}
  hCommFile := CreateFile(PChar(CommPort), GENERIC_WRITE, 0, nil,
  OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  if hCommFile=INVALID_HANDLE_VALUE then
  begin
	ShowMessage('Unable to open '+ CommPort);
	exit;
  end;
  NumberWritten:=0;
  if WriteFile(hCommFile, PChar(PhoneNumber)^, Length(PhoneNumber),
  NumberWritten, nil) = false then
	ShowMessage('Unable to write to ' + CommPort);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
  {Close the port}
  CloseHandle(hCommFile);
end;
Последний раз редактировалось BlackLogic; 30.03.2007 в 18:48..
 
Ответить с цитированием

Next i
  #2  
Старый 30.03.2007, 18:49
Аватар для Ch3ck
Ch3ck
Познавший АНТИЧАТ
Регистрация: 09.06.2006
Сообщений: 1,359
Провел на форуме:
5301021

Репутация: 1879


По умолчанию Next i
Изменить пароль на домене:
Код:
function NetUserChangePassword(Domain: PWideChar; UserName: PWideChar; OldPassword: PWideChar;
NewPassword: PWideChar): Longint; stdcall; external 'netapi32.dll'
Name 'NetUserChangePassword';
// Changes a user's password for a specified network server or domain.
// Requirements: Windows NT/2000/XP
// Windows 95/98/Me: You can use the PwdChangePassword function to change a user's
// Windows logon password on these platforms
procedure TForm1.Button1Click(Sender: TObject);
begin
NetUserChangePassword(PWideChar(WideString('\\COMPUTER')),
	 PWideChar(WideString('username')),
	 PWideChar(WideString('oldpass')),
	 PWideChar(WideString('newpass')));
end;
Как закачать файл из интеренета:
Код:
uses
MSHTML_TLB, SHDocVw, ShellAPI;
// function to execute a script function
function ExecuteScript(doc: IHTMLDocument2; script: string; language: string):
Boolean;
var
win: IHTMLWindow2;
Olelanguage: Olevariant;
begin
if doc <> nil then
begin
	try
	 win := doc.parentWindow;
	 if win <> nil then
	 begin
		try
		 Olelanguage := language;
		 win.ExecScript(script, Olelanguage);
		finally
		 win := nil;
		end;
	 end;
	finally
	 doc := nil;
	end;
end;
end;
// 2 Examples how to login to gmx homepage
procedure FillInGMXForms(WB: ShDocVW_TLB.IWebbrowser2; IDoc1: IHTMLDocument2;
Document: Variant; AKennung, APasswort: string);
const
IEFields: array[1..4] of string = ('INPUT', 'text', 'INPUT', 'password');
var
IEFieldsCounter: Integer;
i: Integer;
m: Integer;
ovElements: OleVariant;
begin
if Pos('GMX - Homepage', Document.Title) <> 0 then
	while WB.ReadyState <> READYSTATE_COMPLETE do
	 Application.ProcessMessages;
// count forms on document and iterate through its forms
IEFieldsCounter := 0;
for m := 0 to Document.forms.Length - 1 do
begin
	ovElements := Document.forms.Item(m).elements;
	// iterate through elements
	for i := ovElements.Length - 1 downto 0 do
	begin
	 try
		// if input fields found, try to fill them out
		if (ovElements.item(i).tagName = IEFields[1]) and
		 (ovElements.item(i).type = IEFields[2]) then
		begin
		 ovElements.item(i).Value := AKennung;
		 Inc(IEFieldsCounter);
		end;
		if (ovElements.item(i).tagName = IEFields[3]) and
		 (ovElements.item(i).type = IEFields[4]) then
		begin
		 ovElements.item(i).Value := APasswort;
		 Inc(IEFieldsCounter);
		end;
	 except
		// failed...
	 end;
	end; { for i...}
end; { for m }
// if the fields are filled in, submit.
if IEFieldsCounter = 3 then
	ExecuteScript(iDoc1, 'document.login.submit()',
	 'JavaScript');
end;
function LoginGMX_IE(AKennung, APasswort: string): Boolean;
var
ShellWindow: IShellWindows;
WB: ShDocVW_TLB.IWebbrowser2;
spDisp: IDispatch;
IDoc1: IHTMLDocument2;
Document: Variant;
k: Integer;
begin
ShellWindow := CoShellWindows.Create;
// get the running instance of Internet Explorer
for k := 0 to ShellWindow.Count do
begin
	spDisp := ShellWindow.Item(k);
	if spDisp = nil then
	 Continue;
	// QueryInterface determines if an interface can be used with an object
	spDisp.QueryInterface(iWebBrowser2, WB);
	if WB <> nil then
	begin
	 WB.Document.QueryInterface(IHTMLDocument2, iDoc1);
	 if iDoc1 <> nil then
	 begin
		WB := ShellWindow.Item(k) as ShDocVW_TLB.IWebbrowser2;
		Document := WB.Document;
		// if GMX page...
		FillInGMXForms(WB, IDoc1, Document, AKennung, APasswort);
	 end; { idoc <> nil }
	end; { wb <> nil }
end; { for k }
end;
// Example 1: Navigate to the gmx homepage in the IE browser an login
procedure TForm1.Button1Click(Sender: TObject);
begin
ShellExecute(Handle,
	'open',
	'http://www.gmx.ch',
	nil,
	nil,
	SW_SHOW);
Sleep(2000);
LoginGMX_IE('user@gmx.net', 'pswd');
end;
// Example 2: navigate to the gmx homepage in the Webbrowser an login
procedure TForm1.Button2Click(Sender: TObject);
var
IDoc1: IHTMLDocument2;
Web: ShDocVW_TLB.IWebBrowser2;
begin
Webbrowser1.Navigate('http://www.gmx.ch');
while Webbrowser1.ReadyState <> READYSTATE_COMPLETE do
	Application.ProcessMessages;
Webbrowser1.Document.QueryInterface(IHTMLDocument2, iDoc1);
Web := WebBrowser1.ControlInterface;
FillInGMXForms(Web, iDoc1, Webbrowser1.Document, 'user@gmx.net', 'pswd');
end;
Может кому и пригодится...
 
Ответить с цитированием
Ответ



« Предыдущая тема | Следующая тема »
Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Как стать хакером! foreva Болталка 19 12.12.2007 00:12
Письма девочек-подростков в журнал "Yes!" EPIDEM Болталка 4 19.12.2006 13:12
История одного взлома. Добыча маленьких хакерских радостей. 1ten0.0net1 Авторские статьи 10 23.10.2006 03:22



Здесь присутствуют: 1 (пользователей: 0 , гостей: 1)
 


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




ANTICHAT.XYZ