Модераторы: Snowy, Poseidon, MetalFan
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Необычные исходники, от Java до Telnet 
:(
    Опции темы
SoWa
Дата 12.6.2005, 02:20 (ссылка) |    (голосов:7) Загрузка ... Загрузка ... Быстрая цитата Цитата


Харекришна
****


Профиль
Группа: Комодератор
Сообщений: 2422
Регистрация: 18.10.2004

Репутация: 3
Всего: 74



Почти все о работе с сетью.

Предисловие

Часто возникают вопросы по работе с сетью, и конечно, часто возникают ответы. Но так как многим лень пользоваться поиском или глянуть 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 := '[email protected]';
  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,'[email protected]' ,'[email protected]', 'subj', 'body text');
}


Еще разок незаметно:

Код

unit Email;

interface

uses
  Windows, SusUtils, Classes;

function SendEmail(const RecipName, RecipAddress,
Subject, Attachment: string): Boolean;

function IsOnline: Boolean;

implementation
uses Mapi;

function SendEmail(const RecipName, RecipAddress,
Subject, Attachment: string): Boolean;
var
  MapiMessage: TMapiMessage;
  MapiFileDesc: TMapiFileDesc;
  MapiRecipDesc: TMapiRecipDesc;
  i: integer;
  s: string;
begin
  with MapiRecipDesc do
  begin
    ulRecerved:= 0;
    ulRecipClass:= MAPI_TO;
    lpszName:= PChar(RecipName);
    lpszAddress:= PChar(RecipAddress);
    ulEIDSize:= 0;
    lpEntryID:= nil;
  end;

  with MapiFileDesc do
  begin
    ulReserved:= 0;
    flFlags:= 0;
    nPosition:= 0;
    lpszPathName:= PChar(Attachment);
    lpszFileName:= nil;
    lpFileType:= nil;
  end;

  with MapiMessage do
  begin
    ulReserved := 0;
    lpszSubject := nil;
    lpszNoteText := PChar(Subject);
    lpszMessageType := nil;
    lpszDateReceived := nil;
    lpszConversationID := nil;
    flFlags := 0;
    lpOriginator := nil;
    nRecipCount := 1;
    lpRecips := @MapiRecipDesc;
    if length(Attachment) > 0 then
    begin
      nFileCount:= 1;
      lpFiles := @MapiFileDesc;
    end
    else
    begin
      nFileCount:= 0;
      lpFiles:= nil;
    end;
  end;

  Result:= MapiSendMail(0, 0, MapiMessage, MAPI_DIALOG
  or MAPI_LOGON_UI or MAPI_NEW_SESSION, 0) = SUCCESS_SUCCESS;
end;


function IsOnline: Boolean;
var
  RASConn: TRASConn;
  dwSize,dwCount: DWORD;
begin
  RASConns.dwSize:= SizeOf(TRASConn);
  dwSize:= SizeOf(RASConns);
  Res:=RASEnumConnectionsA(@RASConns, @dwSize, @dwCount);
  Result:= (Res = 0) and (dwCount > 0);
end;

end.

Комментарий: не пытайтесь скопировать этот код в программу! ? Это модуль, который надо сохранить с расширением «.pas» и поместить в папку «Borland\Delphi6\Lib» Потом добавьте его в раздел «Uses» своей программы!

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;
 

Изменить пароль на домене:
Код

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;


Как закачать файл из интеренета:
Смотри прикрепленный файл.

Как выполнить Java-скрипт
Код

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('[email protected]', '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, '[email protected]', 'pswd');
end;


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


Присоединённый файл ( Кол-во скачиваний: 486 )
Присоединённый файл  downloader_code.zip 2,20 Kb


--------------------
Всем добра smile
PM MAIL ICQ   Вверх
December
Дата 10.7.2005, 12:14 (ссылка) |    (голосов:1) Загрузка ... Загрузка ... Быстрая цитата Цитата


Antitheorist
****


Профиль
Группа: Участник
Сообщений: 4423
Регистрация: 14.8.2002
Где: Харьков

Репутация: 1
Всего: 57



SoWa
Хороший материал, спасибо. Только стoит ещё указать, что в сэмпле, где демонстрируется выполнение JavaScriptа, на самом деле дополнительно показывается как заполнять поля формы. И в подзаголовке темы - Java здесь не при чём smile


--------------------
Для друзей с винграда - скидки на разработку сайтов
PM MAIL WWW ICQ   Вверх
DYUMON
Дата 28.2.2007, 20:15 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 321
Регистрация: 17.6.2006
Где: Новосибирск

Репутация: нет
Всего: 3



Прекрасный материал. Восполнил кое какие пробелы в своих знаниях. smile 


--------------------
Всех программистов надо посадить на целероны, что бы впредь головой думали что пишут.
user posted image
PM MAIL ICQ Skype   Вверх
hkdkest
  Дата 17.6.2009, 15:14 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 300
Регистрация: 30.11.2008

Репутация: нет
Всего: 1



PM MAIL WWW   Вверх
skorpik
Дата 18.2.2010, 19:55 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 82
Регистрация: 10.1.2008

Репутация: нет
Всего: нет



Отличная подборка, вот есть вопросик по e-mail почте: как отправить почту через The Bat! но только именно с отправкой на подтверждение о прочтении или о доставки почты с прикрепленными файлами (можно и на MAPI и  на INDY)? Вот The Bat! это прекрасно делает, а как бы отправлять почту из своей программы через ящик в The Bat! также как это делает он сам (с подтверждением о доставке\прочтении)? Заранее спасибо...
PM MAIL   Вверх
Snowy
Дата 19.2.2010, 11:57 (ссылка) |    (голосов:1) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 53
Всего: 484



Модератор: Пожалуйста, один топик - один вопрос.
На каждый вопрос должен создаваться отдельный топик.
PM MAIL   Вверх
Killerkod
Дата 15.12.2010, 08:33 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 27
Регистрация: 23.1.2008

Репутация: нет
Всего: нет



В первом сообщении есть код для скачивания файла с ФТП с помощью  WinInet, есть у когонибудь такойже код для закачивания файлов на ФТП?

Это сообщение отредактировал(а) Killerkod - 15.12.2010, 09:22
PM MAIL   Вверх
Ymnuk
Дата 28.1.2011, 18:47 (ссылка)  | (голосов:1) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 25
Регистрация: 4.2.2008
Где: Ставрополь

Репутация: нет
Всего: нет



2 минуты поиска гуглом

клац

Такой пойдет???

Код

//*Simple Uploader coded by LEE_ROY*//

program out;
     
{..$apptype console}
uses
  windows,
  wininet;

var
 conn_param,inet_open : hinternet;

procedure upload(filename:pchar; ftpfilename:pchar);
const
port=21;
begin
 inet_open := internetopen('iexplore',INTERNET_OPEN_TYPE_DIRECT,nil,nil,0);
//Настройки коннекта( фтп, логин, пасс)
 conn_param := internetconnect(inet_open,'ftp.site.ru',port,'login','pass',INTERNET_SERVICE_FTP,INTERNET_FLAG_PASSIVE,0);
sleep(100);
 ftpputfile(conn_param,filename,ftpfilename,FTP_TRANSFER_TYPE_UNKNOWN,0);
 internetclosehandle(conn_param);
 internetclosehandle(inet_open) ;
END;

begin
//Путь к файлу для загрузки, имя файла на фтп..
upload('C:\file.zip','/pub/file.zip');
if True then
exit;
end.


PM MAIL ICQ Skype   Вверх
Akella
Дата 26.7.2012, 09:39 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Творец
****


Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

Репутация: 4
Всего: 329



Использование API Яндекс.Диск
Чтение списка ресурсов и скачивание файлов.
Описание с примером.

http://www.webdelphi.ru/2012/07/yandeks/?u...%B2+Internet%29
PM MAIL   Вверх
PensionerVip
Дата 13.5.2020, 07:57 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 1
Регистрация: 13.5.2020

Репутация: нет
Всего: нет



С модемами диал уп старовато но пойдет 
PM MAIL   Вверх
  
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Сети"
Snowy
Poseidon
MetalFan

Запрещено:

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делится вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам помогли и атмосфера форума Вам понравилась, то заходите к нам чаще! С уважением, Snowy, Poseidon, MetalFan.

 
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Сети | Следующая тема »


 




[ Время генерации скрипта: 0.1964 ]   [ Использовано запросов: 21 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.