Осталось реализовать функцию SetCounter

function TWM.SetCounter: String;
var
f:TextFile;
count:Integer;
begin
AssignFile(f,counter_path);
Reset(f);
// Считываем значение счетчика
Readln(f,count);
CloseFile(f);
//Инкреминируем
Inc(count);
Rewrite(f);
// Записываем
writeln(f,count);
CloseFile(f);
Result:=IntToStr(count);
end;

И еще необходимо определить константы имен файлов const

counter_path='counter.dat'; // Файл для значений счетчика
log_path='counter.log'; // Файл для IP адресов

Для работы этого скрипта необходимо создать два файла, для ведения счета и для списка IP. В файле счета необходимо установить начальное значение счетчика, сделать это можно в любом текстовом редакторе.

	Пингуем (Ping) под Delphi

	codenet.ru
	WinSov.com

Протокол 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. 

	Получение списка DLL загруженных приложением

	codenet.ru
	WinSov.com

Иногда бывает полезно знать какими DLL-ками пользуется Ваше приложение. Давайте посмотрим как это можно сделать в Win NT/2000.

Пример функции:

unit ModuleProcs;interfaceuses Windows, Classes;
type
TModuleArray = array[0..400] of HMODULE;
TModuleOption = (moRemovePath, moIncludeHandle);
TModuleOptions = set of TModuleOption;function GetLoadedDLLList(sl: TStrings;
Options: TModuleOptions = [moRemovePath]): Boolean;
implementationuses SysUtils;function GetLoadedDLLList(sl: TStrings;
Options: TModuleOptions = [moRemovePath]): Boolean;
type
EnumModType = function (hProcess: Longint; lphModule: TModuleArray;
cb: DWord; var lpcbNeeded: Longint): Boolean; stdcall;
var
psapilib: HModule;
EnumProc: Pointer;
ma: TModuleArray;
I: Longint;
FileName: array[0..MAX_PATH] of Char;
S: string;
begin
Result := False;
(* Данная функция запускается только для Widnows NT *)
if Win32Platform <> VER_PLATFORM_WIN32_NT then
Exit;
psapilib := LoadLibrary('psapi.dll');
if psapilib = 0 then
Exit;
try
EnumProc := GetProcAddress(psapilib, 'EnumProcessModules');
if not Assigned(EnumProc) then
Exit;
sl.Clear;
FillChar(ma, SizeOF(TModuleArray), 0);
if EnumModType(EnumProc)(GetCurrentProcess, ma, 400, I) then
begin
for I := 0 to 400 do
if ma[i] <> 0 then
begin
FillChar(FileName, MAX_PATH, 0);
GetModuleFileName(ma[i], FileName, MAX_PATH);
if CompareText(ExtractFileExt(FileName), '.dll') = 0 then
begin
S := FileName;
if moRemovePath in Options then
S := ExtractFileName(S);
if moIncludeHandle in Options then
sl.AddObject(S, TObject(ma[I]))
else
sl.Add(S);
end;
end;
end;
Result := True;
finally
FreeLibrary(psapilib);
end;
end;
end.

Для вызова приведённой функции надо сделать следующее:

• Добавить listbox на форму (Listbox1)
• Добавить кнопку на форму (Button1)
• Обработчик события OnClick для кнопки будет выглядеть следующим образом