Сразу же оговорюсь: данный проект нужно было сделать как можно скорее и потому многое в нём выполнено довольно топорно, и в целом сделан он что называется «на коленке». Есть конечно планы доработки и «причёсывания» его, но пока руки не дошли.
Задача состояла в том, чтобы после завершения рабочего дня в локальной сети конторы не оставалось включённых компьютеров. Реализовав самую первую версию проекта я увидел его очень большой недостаток состоящий в том что он выключает всё поголовно (что находит). А это оказалось неправильно. Всё таки некоторые компьютеры должны работать, при этом нигде не должно остаться процессов 1С ни работающих ни, тем более, зависших. Ибо как и у очень многих под покровом ночи происходит автоматическое обновление базы данных этой самой 1С. собственными средствами она может справиться только с корректными процессами (отсоединить их), а вот зависшие увы ей неподвластны, но при этом они (зависшие процессы) в сочетании с обновлением БД перекорёживают эту самую БД.
Итак приступим. Когда задача полностью оформилась она выглядела так: необходимо приложение для Windows которое обойдя заданный диапазон IP-адресов локальной сети нашла бы в нём работающие в данный момент, дальше обратилась к двум спискам исключений выкинула бы из списка найденных «абсолютные исключения» (те с которыми делать не нужно ничего), а с теми которые входят и во второй список «исключений» проделала бы только то, что уничтожила на них только процессы из заданного ей списка, ну а остальные просто выключила. Вот такая вот получилась витиеватая задачка.
Начну с того, что проект основан на функции:
function GetDosOutput(const CommandLine:string):string;
var SA: TSecurityAttributes;
SI: TStartupInfo;
PI: TProcessInformation;
StdOutPipeRead, StdOutPipeWrite: THandle;
WasOK: Boolean;
Buffer: array[0..255] of Char;
BytesRead: Cardinal;
WorkDir, Line: String;
begin
//Application.ProcessMessages;
with SA do
begin
nLength := SizeOf(SA);
bInheritHandle := True;
lpSecurityDescriptor := nil;
end;
// создаём пайп для перенаправления стандартного вывода
CreatePipe(StdOutPipeRead, // дескриптор чтения
StdOutPipeWrite, // дескриптор записи
@SA, // аттрибуты безопасности
0 // количество байт принятых для пайпа - 0 по умолчанию
);
try
// Создаём дочерний процесс, используя StdOutPipeWrite в качестве стандартного вывода,
// а так же проверяем, чтобы он не показывался на экране.
with SI do
begin
FillChar(SI, SizeOf(SI), 0);
cb := SizeOf(SI);
dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
wShowWindow := SW_HIDE;
hStdInput := GetStdHandle(STD_INPUT_HANDLE); // стандартный ввод не перенаправляем
hStdOutput := StdOutPipeWrite;
hStdError := StdOutPipeWrite;
end;
// Запускаем компилятор из командной строки
//изменил я потому что с пустой "рабочей директорией" не работает
//WorkDir := ExtractFilePath(CommandLine);
WorkDir:=GetCurrentDir;
WasOK := CreateProcess(nil, PChar(CommandLine), nil, nil, True, 0, nil, PChar(WorkDir), SI, PI);
// Теперь, когда дескриптор получен, для безопасности закрываем запись.
// Нам не нужно, чтобы произошло случайное чтение или запись.
CloseHandle(StdOutPipeWrite);
// если процесс может быть создан, то дескриптор, это его вывод
if not WasOK then raise Exception.Create('Could not execute command line!')
else
try
// получаем весь вывод до тех пор, пока DOS-приложение не будет завершено
Line := '';
repeat
// читаем блок символов (могут содержать возвраты каретки и переводы строки)
WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
// есть ли что-нибудь ещё для чтения?
if BytesRead > 0 then
begin
// завершаем буфер PChar-ом
Buffer[BytesRead] := #0;
// добавляем буфер в общий вывод
Line := Line + Buffer;
end;
until not WasOK or (BytesRead = 0);
// ждём, пока завершится консольное приложение
WaitForSingleObject(PI.hProcess, INFINITE);
finally
// Закрываем все оставшиеся дескрипторы
CloseHandle(PI.hThread);
CloseHandle(PI.hProcess);
end;
finally
result:=Line;
CloseHandle(StdOutPipeRead);
end;
end;
которая получает получает своим параметром полный текст консольной команды и возвращает текст порождаемый выполнение этой команды в консоли Windows. Признаюсь функция не моя я её где-то нашёл (ввиду того что это было уже довольно давно я точно не помню где, но подозреваю, что на delphiworld.narod.ru) поэтому я привожу её с оригинальными комментариями автора и без каких либо изменений (впрочем для использования в данной программе менять её не было никакой необходимости).
Теперь упомяну какие консольные команды использует данный проект для реализации возложенных на него задач:
1) это всем известный ping он выполняется здесь в таком виде:
ping -a -n 1 <IP-адрес>
где параметр -a это попытка выяснить DNS-имя хоста для последующего использования, параметр -n со значением 1 говорит о том что послать нужно лишь один пакет (а не 4 как задано по умолчанию в Windows, что заметно сокращает время работы программы) и вместо <IP-адрес> передаётся адрес из диапазона поиска. Этой командой программа проверяет доступность «компьютера», иначе говоря включен он или нет.
2) это команда taskkill она выполняется в виде:
taskkill /S <host> /IM <proc> /F
где значение параметра /S (обозначенное здесь как <host>) это DNS-имя компьютера с которым происходит операция, значение параметра /IM (обозначенное здесь как <proc>) это имя процесса (точнее запускающего его файла, например winword.exe) и наконец параметр /F означает принудительное завершение процесса (без всяких вопросов пользователю: уверен он или нет, сохранить или нет и тому подобное). Этой командой, как вы наверное уже поняли, мы убиваем процессы на удалённом компьютере.
3) это выполнение скрипта (приведу его чуть чуть попозже) который выключает удалённый компьютер:
wscript.exe <name>.vbs <host>
ей в качестве параметра передаётся имя скрипта (обозначено <name>) обязательно с расширением (в данном случае это .vbs) потому что это говорит команде какой именно язык скрипта она должна интерпретировать, и уже скрипту в качестве параметра передаётся DNS-имя выключаемого компьютера (обозначено <host>).
Теперь приведу сам скрипт для выключения удалённого компьютера:
' shutdown_net.vbs
' Скрипт удалённое выключение сетевого хоста
' Формат запуска: wscript shutdown_net.vbs <сетевое имя хоста>
' (c) Alone13 2007
' v1.0Dim arg
Dim temp
if wscript.arguments.count <> 1 then
wscript.echo «Ошибка в формате запуска скрипта!!! Формат запуска: wscript shutdown_net.vbs <сетевое имя хоста>»
wscript.quit 0
end if
arg = wscript.arguments(0)
temp = «winmgmts:{impersonationLevel=impersonate,(RemoteShutdown)}//» & arg
Set OpSysSet = GetObject(temp).ExecQuery(«select * from Win32_OperatingSystem where Primary=true»)
for each OpSys in OpSysSet
OpSys.Shutdown()
‘ wscript.echo «Выключаю хост » & arg & » отключён!!!»
Next
Как я уже сказал чуть ранее ему в качестве параметра передаётся DNS-имя удалённого компьютера который нужно выключить. Именно DNS-имя увы но заставить его работать с IP-адресом так и не удалось. Скрипт был написан мною, но ввиду того что я далеко не специалист в VBScript он был написан «по мотивам примеров» и путём модификации примеров взятых с замечательного форума sysadmins.ru (к стати очень его вам рекомендую) сейчас даже тему на нём не вспомню потому, что было это довольно давно (наверное вы и сами заметили это из комментариев в самом скрипте).
Теперь нужно отметить, что начальные параметры программе передаются при помощи ini-файла. Пусть технология и устаревшая но очень надёжная и не требующая написания «конфигуратора» как например в случае если бы все параметры передавались ей при помощи ключей реестра.
Пример ini-файла для описываемой программы:
[General]
Script=script.vbs
StartIP=192.168.1.40
EndIP=192.168.1.51
PrefixLog=Log
LogPath=\log\
DomainFlag=yes
WorkGroup=domain.loc[Isklucheniya]
Count=2
Isk1=server1
Isk2=server2[Isklucheniya2]
Count=1
Isk1=komp1[KillProcess]
Count=1
Process1=1cv8.exe[KillProcess1]
Count=2
Process1=winword.exe
Process2=excel.exe
Давайте разберёмся в нём по порядку:
Секция General задаёт основные вводные:
Script — это имя файла скрипта
StartIP — стартовый IP-адрес диапазона поиска
EndIP — конечный IP-адрес диапазона поиска
PrefixLog — маска для начала имени файлов журнала (например если задано Log, то файл будет называться Log20150201.txt т.е. к префиксу просто прибавляется дата создания и расширение)
PrefixLog — путь к директории хранения log-файлов (у меня это реализовано как поддиректория директории запуска (прошу прощения за тавтологию))
DomainFlag — принимает значение yes/no говорящие о том что мы действуем в домене или воркгруппе соответственно
WorkGroup — имя воркгруппы или домена
Секция Isklucheniya она заведует «обычными исключениями» т.е. те которые не нужно выключать но на которых нужно «убить» критические процессы:
Count — это количество исключений в этой секции (одна из упомянутых топорностей порождённая недостатком времени)
Isk<n> — это DNS-имя компьютера исключения где вместо <n> должно стоять число которое просто обозначает его порядковый номер в этом файле конфигурации.
Секция Isklucheniya2 заведует «абсолютными исключениями» т.е. компьютерами с которыми вообще ничего делать не надо. Устроена она точно так же как и секция Isklucheniya.
Секция KillProcess — это секция перечисляющая процессы которые нужно «убить» на всех компьютерах кроме тех которые перечислены в секции «абсолютных исключений». Устроена она так же как две предыдущих секции с той лишь разницей что вместо Isk<n> используется Process<n>, в остальном всё абсолютно аналогично.
И наконец секция KillProcess1 это список процессов которые нужно «убить» до того как послать удалённому компьютеру команду выключения. Сделано это потому, что на старых ОС (Windows XP) система не завершается если не сохранён например файл в Word выдаёт пользователю сообщение об этом и ждёт когда тот примет решение, а это в данном случае не допустимо (ибо пользователя просто нет). Устроена данная секция как предыдущие три.
Ну вот вроде как со всеми вводными разделался, перейду теперь к описанию самой программы.
В программе задействованы модули:
uses SysUtils, IniFiles, Windows, ShellApi;
Тут, я думаю, особых объяснения не нужно скажу только то что модуль IniFiles нужен для работы с ini-файлами, а ShellApi для работы с командами Windows.
Константы программы:
const cif:Set of Char = ['1','2','3','4','5','6','7','8','9','0'];
NotShutDown:String = 'Ошибка: Сервер RPC недоступен.';
Тут немного поясню: константы cif потребуется для определения является ли символ цифрой или нет, а константа NotShutDown для выявления компьютеров которые невозможно выключить нашим скриптом (например компьютеры или устройства работающие на ОС Linux).
Глобальные переменные программы:
var Isk:array[1..255] of String;
IskCount:Integer;
Script,StartIP,EndIP:String;
IniF:TIniFile;
CurrentDir:String;
i,j:Integer;
IP:String;
rez:-1..1;
FLog:TextFile;
temp:String;
Dir,ArgumentCMD:PChar;
Isk2:array[1..10] of String;
IskCount2:Integer;
KillProcessCount:Integer;
KillProcess:array[1..50] of String;
bb:Boolean;
KillProcessCount1:Integer;
KillProcess1:array[1..50] of String;
Error:String;
PrefixLog,LogPath:String;
DomainFlag:Boolean;
WorkGroup:String;
soobshenie:String;
Массивы Isk и Isk2 это массивы содержащие имена компьютеров-исключений (ещё одна «топорность» стоило бы сделать это на линейных списках, но было не до изяществ) причём «абсолютные» дополняют «обычные» т.е. если содержится в списке «абсолютных» но не содержится в «обычных» то на этапе формирования списков последний будет дополнен недостающими из первого. Переменные IskCount и IskCount2 содержать количества этих исключений (они не могут превышать максимального количества элементов соответствующих массивов). IniF — переменная ini-файла. FLog — переменная для работы с log-файлом. CurrentDir — строковая переменная содержащая полный путь запуска программы (другими словами её рабочую папку). Script, StartIP, EndIP, PrefixLog, LogPath, DomainFlag, WorkGroup — переменные в которые считываются параметры из ini-файла, они созвучны этим самым параметрам. Массивы KillProcess и KillProcess1 а так же переменные KillProcessCount и KillProcessCount1 аналогичным таким же массивам и переменным для исключений (о них я только что сказал) только они предназначены для процессов (взаимодополнение массивов тоже аналогично). Error -строковая переменная содержит текст ошибки возникшей в определенной ситуации. soobshenie — строковая переменная которая содержит сообщение выводимое в лог. Остальные переменные являются внутренними, промежуточными и прочее значение которых либо меняется либо будет указано далее.
И вот наконец мы добрались до текста тела программы (используемые локальные процедуры и функции будут описаны и приведены по ходу объяснения, кроме той которую я уже упомянул). И так текст программы:
begin
If CurrentIni(Error,'ShutDownComp.ini') Then
Begin
Dir:=PChar(CurrentDir);
temp:=FormatDateTime('yyyymmdd',Date);
temp:=LogPath+PrefixLog+temp+'.txt';
AssignFile(FLog,temp);
ReWrite(FLog);
WriteLn(FLog,'Начало сканирования '+DateToStr(Date)+' '+TimeToStr(Time));
IP:=StartIP;
While IPMensheIliRavno(IP,EndIP) do
Begin
rez:=ping(IP);
If rez=-1 Then
Begin
temp:=NameComp(IP);
bb:=False;
If IskCount2>0 Then
For i:=1 to IskCount2 do
If UpperCase(temp)=UpperCase(Isk2[i]) Then bb:=True;
If NOT(bb) Then
Begin
WriteLn(FLog,IP+' '+temp+' - Да, но исключение');
If KillProcessCount>0 Then
Begin
For i:=1 to KillProcessCount do
Begin
soobshenie:=KillP(temp,KillProcess[i]);
Write(FLog,soobshenie);
End;
End
Else WriteLn(FLog,'Не задано процессов для удаления');
End
Else WriteLn(FLog,IP+' '+temp+' - Да, но высшее исключение');
End;
If rez=0 Then WriteLn(FLog,IP+' - Нет');
If rez=1 Then
Begin
temp:=NameComp(IP);
WriteLn(FLog,IP+' '+temp+' - Да');
for i:=1 to KillProcessCount1 do
Begin
soobshenie:=KillP(temp,KillProcess1[i]);
Write(FLog,' '+soobshenie);
End;
ArgumentCMD:=PChar(' '+Script+' '+temp);
If Pos(NotShutDown,soobshenie)<=0 Then
ShellExecute(0,'','wscript.exe',ArgumentCMD,Dir,SW_Show);
End;
IP:=IncIPAdres(IP);
End;
End
Else
Begin
temp:=FormatDateTime('yyyymmdd',Date);
temp:='log'+temp+'.txt';
AssignFile(FLog,temp);
ReWrite(FLog);
WriteLn(FLog,'Начало сканирования '+DateToStr(Date)+' '+TimeToStr(Time));
WriteLn(FLog,' Ошибки в INI-файле ('+Error+')');
End;
WriteLn(FLog,'Конец сканирования '+DateToStr(Date)+' '+TimeToStr(Time));
CloseFile(FLog);
end.
Начинаем мы с того что вызываем функцию проверки ini-файла на корректность и заодно заполняющую вводные для программы из этого файла. Если файл содержит какие либо ошибки, то тест последней найденной сохраняется в переменной Error, выполнение программы не допускается, в журнал пишется соответствующее сообщение и на этом работа программы заканчивается.
Текст функции CurrentIni:
function CurrentIni(var ErrorMessage:String; name:String):Boolean;
var bbb,nnn:Boolean;
tt:String;
k:Integer;
Begin
bbb:=True;
CurrentDir:=GetCurrentDir+'\';
If not(FileExists(CurrentDir+name)) Then
Begin
bbb:=False;
ErrorMessage:='INI-файл не существует';
End
Else
Begin
IniF:=TIniFile.Create(CurrentDir+name);
tt:=IniF.ReadString('Isklucheniya','Count','0');
nnn:=True;
for k:=1 to Length(tt) do
If not(tt[k] in cif) Then nnn:=False;
If nnn Then IskCount:=StrToInt(tt)
Else
Begin
bbb:=False;
ErrorMessage:='Ошибка в строке Count секции Isklucheniya';
End;
tt:=IniF.ReadString('Isklucheniya2','Count','0');
nnn:=True;
for k:=1 to Length(tt) do
If not(tt[k] in cif) Then nnn:=False;
If nnn Then IskCount2:=StrToInt(tt)
Else
Begin
bbb:=False;
ErrorMessage:='Ошибка в строке Count секции Isklucheniya2';
End;
tt:=IniF.ReadString('KillProcess1','Count','0');
nnn:=True;
for k:=1 to Length(tt) do
If not(tt[k] in cif) Then nnn:=False;
If nnn Then KillProcessCount1:=StrToInt(tt)
Else
Begin
bbb:=False;
ErrorMessage:='Ошибка в строке Count секции KillProcess1';
End;
tt:=IniF.ReadString('KillProcess','Count','0');
nnn:=True;
for k:=1 to Length(tt) do
If not(tt[k] in cif) Then nnn:=False;
If nnn Then KillProcessCount:=StrToInt(tt)
Else
Begin
bbb:=False;
ErrorMessage:='Ошибка в строке Count секции KillProcess';
End;
Script:=IniF.ReadString('General','Script','proba.vbs');
If not(FileExists(CurrentDir+Script)) Then
Begin
bbb:=False;
ErrorMessage:='Ошибка в строке Script секции General';
End;
StartIP:=IniF.ReadString('General','StartIP','none');
If NOT(ProverkaIP(StartIP)) Then
Begin
bbb:=False;
ErrorMessage:='Ошибка в строке StartIP секции General';
End;
EndIP:=IniF.ReadString('General','EndIP','none');
If NOT(ProverkaIP(EndIP)) Then
Begin
bbb:=False;
ErrorMessage:='Ошибка в строке EndIP секции General';
End;
If bbb Then
Begin
If NOT(IPMensheIliRavno(StartIP,EndIP)) Then
Begin
bbb:=False;
ErrorMessage:='Начальный IP-адрес больше конечного';
End;
End;
PrefixLog:=IniF.ReadString('General','PrefixLog','none');
If (PrefixLog='none') OR (PrefixLog='') Then PrefixLog:='Log';
LogPath:=IniF.ReadString('General','LogPath','none');
LogPath:=CurrentDir+LogPath;
If NOT(DirectoryExists(LogPath)) Then CreateDir(LogPath);
tt:=IniF.ReadString('General','DomainFlag','no');
If tt='yes' Then
Begin
DomainFlag:=True;
WorkGroup:=IniF.ReadString('General','WorkGroup','');
End
Else
Begin
DomainFlag:=False;
WorkGroup:='';
End;
If IskCount>245 then IskCount:=245;
if IskCount>0 then
begin
for i:=1 to IskCount do
Isk[i]:=IniF.ReadString('Isklucheniya','ISK'+IntToStr(i),'Error Name');
end;
If IskCount2>10 then IskCount2:=10;
if IskCount2>0 then
begin
for i:=1 to IskCount2 do
Begin
Isk2[i]:=IniF.ReadString('Isklucheniya2','ISK'+IntToStr(i),'Error Name');
bb:=False;
For j:=1 to IskCount do If Isk[j]=Isk2[i] Then bb:=True;
If Isk2[i]='Error Name' Then bb:=True;
If NOT(bb) Then
Begin
IskCount:=IskCount+1;
Isk[IskCount]:=Isk2[i];
End;
End;
End;
If KillProcessCount1>25 then KillProcessCount1:=25;
if KillProcessCount1>0 then
begin
for i:=1 to KillProcessCount1 do
KillProcess1[i]:=IniF.ReadString('KillProcess1','Process'+IntToStr(i),'Error Name Process');
end;
If KillProcessCount>25 then KillProcessCount:=25;
if KillProcessCount>0 then
begin
for i:=1 to KillProcessCount do
Begin
KillProcess[i]:=IniF.ReadString('KillProcess','Process'+IntToStr(i),'Error Name Process');
bb:=False;
for j:=1 to KillProcessCount1 do
If KillProcess[i]=KillProcess1[j] Then bb:=True;
If KillProcess[i]='Error Name Process' Then bb:=True;
If NOT(bb) Then
Begin
KillProcessCount1:=KillProcessCount1+1;
KillProcess1[KillProcessCount1]:=KillProcess[i];
End;
End;
end;
IniF.Free;
End;
CurrentIni:=bbb;
End;
Её параметрами являются уже упомянутая переменная Error и переменная содержащая имя ini-файла. Возвращает она True если файл корректен или False если нет. По моему в ней всё интуитивно понятно. Происходят различные проверки правильности самого файла и его содержимого и не более того. скажу только, что функция GetCurrentDir возвращает строковое значение директории запуска программы без последнего слеша, функция FileExists проверяет существование файла по его полному имени (она из стандартных библиотек Delphi), а метод ReadString это метод класса TIniFile который возвращает значение параметра из ini-файла его аргументами являются: имя секции ini-файла, имя переменной ini-файла и значение по умолчанию (на тот случай если считать не удалось).
Теперь вернёмся к тексту программы:
temp:=FormatDateTime('yyyymmdd',Date);
temp:=LogPath+PrefixLog+temp+'.txt';
AssignFile(FLog,temp);
ReWrite(FLog);
WriteLn(FLog,'Начало сканирования '+DateToStr(Date)+' '+TimeToStr(Time));
это фрагмент где формируется имя файла журнала и в него записывается сообщение о начале работы программы.Далее циклом While перебираются все IP-адреса переменной IP тут собственно и происходит главное действо программы. Начинаем с начального который у нас содержится в переменной StartIP и далее пока не достигнем последнего (переменная EndIP). Сравнение реализовано функцией IPMensheIliRavno(IP,EndIP). Первый её аргумент это IP текущий а второй IP которого он не должен превысить (в нашем случае EndIP).Текст функции IPMensheIliRavno:
function IPMensheIliRavno(ip1,ip2:String):Boolean;
var ss1,ss2:String;
i:Integer;
pp1,pp2:Integer;
CountT:Integer;
Begin
ss1:='';
ss2:='';
CountT:=0;
For i:=1 to Length(ip1) do
Begin
If ip1[i]='.' Then CountT:=CountT+1
Else If CountT=3 Then ss1:=ss1+ip1[i];
End;
CountT:=0;
For i:=1 to Length(ip2) do
Begin
If ip2[i]='.' Then CountT:=CountT+1
Else If CountT=3 Then ss2:=ss2+ip2[i];
End;
pp1:=StrToInt(ss1);
pp2:=StrToInt(ss2);
If pp1<=pp2 Then IPMensheIliRavno:=True
Else IPMensheIliRavno:=False;
End;
Ничего сложного в ней нет. А такой громоздкой она получилась потому, что все параметры её текстового типа (ещё одна не очень изящная вещь). Она Возвращает True если предел ещё не достигнут и False если достигнут. Надо заметить что везде и в этой функции тоже смещение и сравнение происходит только по последнему актанту IP-адреса.
Снова вернёмся к телу программы. дальше у нас всплывает функция ping которая передаёт своё значение переменной rez (прошу не путать в данном случае речь идёт о функции внутри программы а не о ping-е запускаемом в консоли Windows). приведём её текст:
function ping(host:String):Integer;
{
Результаты:
-1 исключение
0 не в сети
1 в сети
}
var i,p,tt:Integer;
ss:String;
IskProv:Boolean;
begin
ss:=GetDosOutput('ping -a -n 1 '+host);
Convert1(ss);
p:=Pos('Ответ от '+host+': число байт=32 время',ss);
IskProv:=False;
For i:=1 to IskCount do
Begin
tt:=Pos(UpperCase('Обмен пакетами с '+Isk[i]),UpperCase(ss));
If tt>0 then IskProv:=True;
End;
If p>0 Then
Begin
If IskProv Then ping:=-1
Else ping:=1;
End
Else ping:=0;
end;
Функция возвращает одно из трёх значений. Это -1, 0 или 1 что означает «компьютер является исключение», «компьютер не в сети» или «компьютер в сети» соответственно. Она поступает следующим образом: вызывает функцию GetDosOutput (упомянутую в самом начале) перекодирует стандартный консольный вывод при помощи внутренней функции Convert1 из кодировки Dos в кодировку Windows и анализирует полученный строки. Если в выводе имеются знаковые сочетания (в нашем случае «Ответ от» и «: число байт=32 время») значит компьютер есть в сети. Так же она заглядывает в массив обычных исключений и смотрит нет ли там сканируемого компьютера, путём перебора всех исключений, присовокупления их имён к строке «Обмен пакетами с» и поиска вхождения в полученный строки. функция Pos(ss1,ss2) возвращает номер позиции вхождения строки ss1 в строку ss2 или 0 если вхождения нет, она входит в стандартные библиотеки Delphi.
Текст функции перекодировки:
procedure Convert1(var a:string);
{ASCII->ANSI}
var i:integer;
begin
for i:=1 to length(a) do
if ord(a[i]) in [128..175] then a[i]:=chr(ord(a[i])+64)
else if ord(a[i]) in [224..239] then a[i]:=chr(ord(a[i])+16)
else if ord(a[i])=240 then a[i]:=chr(ord(168))
else if ord(a[i])=241 then a[i]:=chr(ord(184));
end;
писал не сам ввиду экономии времени и честно сказать банальной лени, но в ней всё по моему абсолютно понятно.
Вернёмся снова к тексту программы. Остановились мы на том, что в переменную rez записалось значение нашего пинга. Теперь перед нами три пути:
1) значение 0 — это компьютер не в сети, мы просто пишем в лог что он не в сети и переходим к следующему IP.
2) значение -1 — это компьютер исключение значит. Выясняем его имя (при помощи функции NameComp) и заглядываем в список «абсолютных исключений» если он там есть, то ничего с ним не делаем и записываем это в лог, если же его там нет, то убиваем на нём процессы из списка обязательных к «убиению» (делаем это функцией KillP) и записываем об этом сообщение в лог.
3) значение 1 — это означает что нам попался совершенно рядовой компьютер и нам его нужно просто выключить. Мы так же выясняем его имя, убиваем на нём процессы из списка тех которые мешают выключению и выключаем его но тут уже без использования функции GetDosOutput а напрямую стандартной функцией из библиотек Delphi ShellExecute потому как её консольный вывод нам не нужен. Только делаем это в том случае если можем это возможно, для определения чего используем константу NotShutDown, о которой я уже упоминал ранее. Ну и обо всём об этом тоже пишем в лог.
Теперь приведу текст функций только что мною упомянутых:
function NameComp(host:String):String;
{возвращает имя компьютера или <none> когда имени нет или выяснить не удалось}
const fraza:String = 'Обмен пакетами с ';
var ss,ss1:String;
p,i,p1,p2:Integer;
Begin
ss:=GetDosOutput('ping -a -n 1 '+host);
Convert1(ss);
p1:=Pos('[',ss);
p2:=Pos(']',ss);
If (p1>0) AND (p2>0) then
Begin
p:=Pos(fraza,ss);
ss1:='';
i:=p+Length(fraza);
While NOT(ss[i]='.') AND NOT(ss[i]=' ') do
Begin
ss1:=ss1+ss[i];
i:=i+1;
End;
End
Else ss1:='<none>';
NameComp:=ss1;
End;
Ничего сложного основана она всё так же на стандартном консольном выводе команды ping из которого мы извлекаем DNS-имя пингуемого компьютера. Она возвращает, как указано в её комментарии, либо имя компьютера либо строку «<none>».
function KillP(host,proc:String):String;
var ss:String;
begin
ss:=GetDosOutput('taskkill /S '+host+' /IM '+proc+' /F');
Convert1(ss);
KillP:=ss;
end;
Ещё более простая функция которая просто возвращает стандартный вывод команды taskkill.
Ну вот в общем то и всё. Возможно я конечно что-то не учёл или не договорил, в этом случае не стесняйтесь обращайтесь на почту или пишите в комментариях.
Исходники данного творения можно скачать Здесь.