Отправляет email-рассылки с помощью сервиса Sendsay

СообЧА. Программирование на Delphi

Рассылка закрыта

При закрытии подписчики были переданы в рассылку "Программирование в Delphi" на которую и рекомендуем вам подписаться.

Вы можете найти рассылки сходной тематики в Каталоге рассылок.

←   Декабрь 2001   →
 1
 2
 3
 4
 5
 6
06.12.2001
16:13:59
22:11:05
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Автор
Сергей

Статистика

10.085 подписчиков
-9 за неделю
←   Все выпуски   →

СообЧА. Программирование на Delphi


Служба Рассылок Subscribe.Ru
Subscribe.Ru :СообЧа программирование на дельфи !
™—Сообча : программирование на дельфи —

Здесь СЕРЬЕЗНО могла бы быть ЛЮБАЯ ваша реклама: обращайтесь ко мне... Стоимость размещения в 1 номере 10 рублей.

Нас читают более 3000 человек ...
С наступаю..... ой , не то!
 В этом выпуске:

На сайте рассылки Pixelsoftware, есть файл-подарок СообЧайникам!!!!
Рассылки Subscribe.Ru это стильно удобно, и информативно!
СообЧа (СООБщество ЧАйников). Обмен опытом, вопросы, ответы.
подпишись и подпиши друга!!!!

 Contact (Связь с Нами):

Pixel@novgorod.net + Subject:

Vcl Haunting

"Золотой Чайник"

Вопрос по дельфи N (номер версии)

Help!

 

 

Новости (Слово о нашем спонсоре...)

К заголовку

Лучшие товары ОЗОНА

Внимание , хелп!

Люди, у меня постоянно вылетает мой монитор LG flatron 17, изображение корежит и стягивает, уже треий раз ремонтируют.... Кто поможет с диагнозом и как его "лечить", поможет сократиь промежуток выхода рассылки.

  • Sudden Strike(противостояние 3) убойная ТАКТИЧЕСКИ ГРАМОТНАЯ RTS на тему 2й мировой войны...
  • Демиурги: Вы фанат Magic the Gathering? Тогда это для вас!!!!

Книги по Дельфи которые ВЫ ОБЯЗАНЫ ПРОЧИТАТЬ...

Не столько учебник, сколько справочное пособие по наиболее используемым алгоритмам и командам...

Пожалуй лучший учебник по дельфи 6 на сегодняшний день, вам даже не надо знать дельфи, чтобы начать ...

Купите- не пожалеете!

 

О наболевшем :Модуль кейген (с)Мой

К заголовку

Вот я и написал свою первую компоненту. Да еще и какую! Данный кейген имеет немного оригинальный алгоритм, по сравнению с тем что я видел ранее. Код еще сыроват, но все работает(Проверено на дельфи5).

Как пользоваться:
после установки перетащить на форму и вводить имя(логин) в виде keygen1.yourname:='something'
получить ключ можно через свойство serial:=keygen1.yourcode

unit keygen;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;


type
Tkeygen = class(Tcomponent)

private
function encodeserial:string;
protected

{ Protected declarations }
public

published
procedure itsux(n:string);
property yourname:string write itsux;
property yourcode:string read encodeserial ;
end;
var
names:string;

procedure Register;

implementation

procedure tkeygen.itsux(n:string);
begin
names:=n ;
end ;

function tkeygen.encodeserial:string;
var
i,num:integer;
serial:string;
begin
num:=0;
for i:=1 to length(names) do begin
case names[i] of
'A','a','А','0','а':num:=num+12345;
'B','b','Б','б':num:=num+232055;
'C','c','1','В','в':num:=num+113482;
'D','d','2','Г','г':num:=num+610470;
'E','e','3','Д','д':num:=num-13270;
'F','f','Е','е':num:=num+53588;
'G','6','g','Ё','ё':num:=num-90;
'H','h','Ж','ж':num:=num+8199;
'I','i','З','з',',':num:=num+8752333;
'J','j','И','и','.':num:=num+5671711;
'K','k','К','5','к','Я','я':num:=num+15466;
'L','l','Л','л','+','-':num:=num+16767;
'M','4','m','М','м','<','>':num:=num+70966;
'N','n','Н','н','=','_':num:=num+40652;
'O','o','О','о','','~':num:=num+27835;
'P','9','p','П','п','*',' ':num:=num+1566834;
'Q','q','Р','р':num:=num+34103;
'R','r','С','с','Ю','ю':num:=num+7816434;
'S','7','s','8','Т','т':num:=num-87900;
'T','t','У','у','Э','э':num:=num+84555;
'U','u','Ф','ф':num:=num+51515;
'V','v','Х','х','/':num:=num+151610;
'W','w','Ц','ц','\':num:=num+41107;
'X','x','Ч','ч':num:=num*3;
'Y','y','Ъ','ъ','ь','Ь':num:=num*2;
'Z','z','Ы','ы':num:=num*10;
else begin
application.MessageBox('Unknown Symbol','ERROR!!!',21);
num:=num-1
end;

end;
end;
num:=num+117554304;
serial:='PIX'+inttostr(num);
for i:=0 to 14 do begin
if length(serial)<12 then begin
serial:=serial+'0';
end;
if length(serial)>12 then begin
serial[20-i]:=' ';
trimright(serial);
end;
end;
result:=serial;
end ;

procedure Register;
begin
RegisterComponents('Soobcha', [TKeygen]);
end;

end.


 

 

Пингуем под дельфи

К заголовку

Протокол Ping предназначен для тестирования компьютерных соединений в Интернете путём посылки через протокол Internet Protocol (IP) по обределённому адресу сообщения и ожидания от него ответа.

ICMP - Internet Control Message Protocol. ICMP служит для передачи сообщений об ошибках а так же управляющих сообщений . ICMP-тест может показать насколько быстро проходит информация между двумя узлами в Интернете.


1. Запускаем Delphi;
2. В Новом проекте добавляем в форму Tbutton, Tedit и Tmemo;
3. Вставляем “winsock”;
4. объявляем структурку для IP-заголовка:
type
IPINFO = record
Ttl :char;
Tos :char;
IPFlags :char;
OptSize :char;
Options :^char;
end;

5. объявляем структурку для хранения ICMP пакета:
type
ICMPECHO = record
Source :longint;
Status :longint;
RTTime :longint;
DataSize:Shortint;
Reserved:Shortint;
pData :^variant;
i_ipinfo:IPINFO;
end;

6. Объявляем функции и процедуры, которые мы будем вызывать из ICMP.DLL
TIcmpCreateFile = function():integer; {$IFDEF WIN32} stdcall; {$ENDIF}
TIcmpCloseHandle = procedure(var handle:integer);{$IFDEF WIN32} stdcall; {$ENDIF}
TIcmpSendEcho = function(var handle:integer; endereco:DWORD; buffer:variant; tam:WORD; IP:IPINFO; ICMP:ICMPECHO; tamicmp:DWORD; tempo:DWORD):DWORD;{$IFDEF WIN32} stdcall; {$ENDIF}

7. В Tbutton в событие Onclick вставляем следующий код:

procedure TForm1.Button1Click(Sender: TObject);
var
wsadt : wsadata;
icmp :icmpecho;
HNDicmp : integer;
hndFile :integer;
Host :PHostEnt;
Destino :in_addr;
Endereco :^DWORD;
IP : ipinfo;
Retorno :integer;
dwRetorno :DWORD;
x :integer;

IcmpCreateFile : TIcmpCreateFile;
IcmpCloseHandle : TIcmpCloseHandle;
IcmpSendEcho : TIcmpSendEcho;

begin
if (edit1.Text = '') then begin
Application.MessageBox('Enter a HostName ro a IP Adress',
'Error', MB_OK);
exit;
end;
HNDicmp := LoadLibrary('ICMP.DLL');
if (HNDicmp <> 0) then begin
@IcmpCreateFile := GetProcAddress(HNDicmp,'IcmpCreateFile');
@IcmpCloseHandle := GetProcAddress(HNDicmp,'IcmpCloseHandle');
@IcmpSendEcho := GetProcAddress(HNDicmp,'IcmpSendEcho');
if (@IcmpCreateFile=nil) or (@IcmpCloseHandle=nil) or (@IcmpSendEcho=nil) then begin
Application.MessageBox('Error getting ICMP Adress’,'Error', MB_OK);
FreeLibrary(HNDicmp);
end;
end;
Retorno := WSAStartup($0101,wsadt);

if (Retorno <> 0) then begin
Application.MessageBox('Canґt Load WinSockets','WSAStartup', MB_OK);
WSACleanup();
FreeLibrary(HNDicmp);
end;

Destino.S_addr := inet_addr(Pchar(Edit1.text));
if (Destino.S_addr = 0) then begin
Host := GetHostbyName(PChar(Edit1.text));
end
else begin
Host := GetHostbyAddr(@Destino,sizeof(in_addr), AF_INET);
end;

if (host = nil) then begin
Application.MessageBox('Host not found','Error', MB_OK);
WSACleanup();
FreeLibrary(HNDicmp);
exit;
end;
memo1.Lines.Add('Pinging ' + Edit1.text);

Endereco := @Host.h_addr_list;

HNDFile := IcmpCreateFile();
for x:= 0 to 4 do begin
Ip.Ttl := char(255);
Ip.Tos := char(0);
Ip.IPFlags := char(0);
Ip.OptSize := char(0);
Ip.Options := nil;

dwRetorno := IcmpSendEcho(
HNDFile,
Endereco^,
null,
0,
Ip,
Icmp,
sizeof(Icmp),
DWORD(5000));
Destino.S_addr := icmp.source;
Memo1.Lines.Add('Ping ' + Edit1.text);
end;


IcmpCLoseHandle(HNDFile);
FreeLibrary(HNDicmp);
WSACleanup();
end;

У данного примера есть один недостаток - программа не воспримет доменное имя, только IP-адресс. Для пользователей NT не используйте функцию IcmpCloseHandle.

Это всё…..

Ну и в конце полный исходный код примера:

----------------------------------
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
winsock, StdCtrls;

type
IPINFO = record
Ttl :char;
Tos :char;
IPFlags :char;
OptSize :char;
Options :^char;
end;

type
ICMPECHO = record
Source :longint;
Status :longint;
RTTime :longint;
DataSize:Shortint;
Reserved:Shortint;
pData :^variant;
i_ipinfo:IPINFO;
end;

TIcmpCreateFile = function():integer; {$IFDEF WIN32} stdcall; {$ENDIF}
TIcmpCloseHandle = procedure(var handle:integer);{$IFDEF WIN32} stdcall; {$ENDIF}
TIcmpSendEcho = function(var handle:integer; endereco:DWORD; buffer:variant; tam:WORD; IP:IPINFO; ICMP:ICMPECHO; tamicmp:DWORD; tempo:DWORD):DWORD;{$IFDEF WIN32} stdcall; {$ENDIF}


type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Edit1: TEdit;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public

end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
wsadt : wsadata;
icmp :icmpecho;
HNDicmp : integer;
hndFile :integer;
Host :PHostEnt;
Destino :in_addr;
Endereco :^DWORD;
IP : ipinfo;
Retorno :integer;
dwRetorno :DWORD;
x :integer;

IcmpCreateFile : TIcmpCreateFile;
IcmpCloseHandle : TIcmpCloseHandle;
IcmpSendEcho : TIcmpSendEcho;

begin
if (edit1.Text = '') then begin
Application.MessageBox('Digite um HostName ou um End. IP',
'Error', MB_OK);
exit;
end;
HNDicmp := LoadLibrary('ICMP.DLL');
if (HNDicmp <> 0) then begin
@IcmpCreateFile := GetProcAddress(HNDicmp,'IcmpCreateFile');
@IcmpCloseHandle := GetProcAddress(HNDicmp,'IcmpCloseHandle');
@IcmpSendEcho := GetProcAddress(HNDicmp,'IcmpSendEcho');
if (@IcmpCreateFile=nil) or (@IcmpCloseHandle=nil) or (@IcmpSendEcho=nil) then begin
Application.MessageBox('Erro pegando endereзos ICMP','Error', MB_OK);
FreeLibrary(HNDicmp);
end;
end;
Retorno := WSAStartup($0101,wsadt);

if (Retorno <> 0) then begin
Application.MessageBox('Nгo foi possнvel carregar WinSockets','WSAStartup', MB_OK);
WSACleanup();
FreeLibrary(HNDicmp);
end;

Destino.S_addr := inet_addr(Pchar(Edit1.text));
if (Destino.S_addr = 0) then begin
Host := GetHostbyName(PChar(Edit1.text));
end
else begin
Host := GetHostbyAddr(@Destino,sizeof(in_addr), AF_INET);
end;

if (host = nil) then begin
Application.MessageBox('Host nгo encontrado','Error', MB_OK);
WSACleanup();
FreeLibrary(HNDicmp);
exit;
end;
memo1.Lines.Add('Pinging ' + Edit1.text);

Endereco := @Host.h_addr_list;

HNDFile := IcmpCreateFile();
for x:= 0 to 4 do begin
Ip.Ttl := char(255);
Ip.Tos := char(0);
Ip.IPFlags := char(0);
Ip.OptSize := char(0);
Ip.Options := nil;

dwRetorno := IcmpSendEcho(
HNDFile,
Endereco^,
null,
0,
Ip,
Icmp,
sizeof(Icmp),
DWORD(5000));
Destino.S_addr := icmp.source;
Memo1.Lines.Add('Pingou ' + Edit1.text);
end;


IcmpCLoseHandle(HNDFile);
FreeLibrary(HNDicmp);
WSACleanup();
end;

end.

 


 

 

До встречи...

Zaluskiy Anton(COOLer)  и Khrapunov Kirill(Pixel)  - ведущие проекта    "Мир Delphi" Copyright : Pixelsoftware(Pixel)& Delphi 2000(COOLer)


к3кй TopList SpyLOG RLE Banner Network
http://subscribe.ru/
E-mail: ask@subscribe.ru		 Отписаться
Убрать рекламу		 Рейтингуется SpyLog

 

Another Banner Network

http://subscribe.ru/
E-mail: ask@subscribe.ru 		Отписаться
Убрать рекламу 		Рейтингуется SpyLog
http://subscribe.ru/
E-mail: ask@subscribe.ru 		Отписаться
Убрать рекламу
В избранное