Мы переехали http://www.webxakep.net

Среда, 15.05.2024
На главную · Регистрация · Войти · Пользователи · User`Bars · Обратная связь · WebTools · Последние сообщения · Поиск

  • Страница 1 из 1
  • 1
Модератор форума: 3xstie  
WebXakep » Кодинг » Системный » Алгоритмы на Delphi (Алгоритмы программ.)
Алгоритмы на Delphi

4RXRU5HДата: Пятница, 13.04.2007, 18:49 | Сообщение # 1
0xFFFFFFF
Группа: Основатель
Сообщений:271
Статус: Offline
Здесь выкладываем и обсуждаем алгоритмы написаные на Delphi

 


ArxWolfДата: Вторник, 17.04.2007, 15:32 | Сообщение # 2
Administration Men
Группа: Основатель
Сообщений:184
Статус: Offline
Проверяет IP адрес на правельность(по всем точкам) :
Function TestIP(IP : String) : Boolean;
Var
I,ex : Integer;
Begin
Result := False;
If IP = '' Then Exit;
ex := 0;
For I := 1 To Length(IP) Do
If IP[I] = '.' Then
Inc(ex);
If ex = 3 Then
Result := True;
End;




 


ArxWolfДата: Вторник, 17.04.2007, 15:35 | Сообщение # 3
Administration Men
Группа: Основатель
Сообщений:184
Статус: Offline
Полезный алг, он подымает IP - String - 127.0.0.1 на 1 число выше,
получеться - String - 127.0.0.2. Написан для сканера диапозонов :

Function IncIP(IP : String) : String;
Var
Tchk : Array[1..4] Of Integer;
I,ex,SDF : Integer;
Begin
ex := 0;
SDF := 1;
For I := 1 To Length(IP) Do
If IP[I] = '.' Then Begin
Tchk[SDF] := StrToInt(Copy(IP,ex+1,(I-1)-ex));
ex := I;
Inc(SDF);
End;
Tchk[4] := StrToInt(Copy(IP,ex+1,(Length(Ip))-ex));
Tchk[4] := Tchk[4] + 1;
If Tchk[4] > 255 Then Begin
Tchk[4] := 0;
Tchk[3] := Tchk[3] + 1;
End;
If Tchk[3] > 255 Then Begin
Tchk[3] := 0;
Tchk[2] := Tchk[2] + 1;
End;
If Tchk[2] > 255 Then Begin
Tchk[2] := 0;
Tchk[1] := Tchk[1] + 1;
End;
Result := IntToStr(Tchk[1])+'.'+IntToStr(Tchk[2])+'.'+IntToStr(Tchk[3])+'.'+IntToStr(Tchk[4]);
End;




 


ArxWolfДата: Пятница, 20.04.2007, 05:31 | Сообщение # 4
Administration Men
Группа: Основатель
Сообщений:184
Статус: Offline
Авто загрузка на чистом WinApi

Uses Windows;
Procedure RegistredProgramm;
Const
XName = 'My first program';
Var
Key : Hkey;
FileName : Array[0..255] Of Char;
Begin
GetModuleFileName(0,FileName,SizeOf(FileName));
RegOpenKey(HKEY_LOCAL_MACHINE,'SOFTWARE\Microsoft\Windows\CurrentVersion\Run',Key);
RegSetValueEx(Key,XName,0,REG_SZ,@FileName,SizeOf(FileName));
RegCloseKey(Key);
End;




 


ArxWolfДата: Пятница, 20.04.2007, 05:34 | Сообщение # 5
Administration Men
Группа: Основатель
Сообщений:184
Статус: Offline
Режимы компа..
Выключить :
procedure ExitWinNT(AShutdown: Boolean);
var
hToken: THandle;
tkp: TTokenPrivileges;
ReturnLength: Cardinal;
begin
if OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or
TOKEN_QUERY, hToken) then
begin
LookupPrivilegeValue(nil, 'SeShutdownPrivilege', tkp.Privileges[0].Luid);
tkp.PrivilegeCount := 1;
tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
if AdjustTokenPrivileges(hToken, False, tkp, 0, nil, ReturnLength) then
ExitWindowsEx(EWX_SHUTDOWN or ewx_force,0);
end;
end;

Ждущий режим :
procedure NTWait;
var
hToken: THandle;
tkp: TTokenPrivileges;
ReturnLength: Cardinal;
begin
if OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or
TOKEN_QUERY, hToken) then
begin
LookupPrivilegeValue(nil, 'SeShutdownPrivilege', tkp.Privileges[0].Luid);
tkp.PrivilegeCount := 1;
tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
if AdjustTokenPrivileges(hToken, False, tkp, 0, nil, ReturnLength) then
SetSystemPowerState(true, true);
end;
end;

Перезагрузка :
procedure NTReboot;
var
hToken: THandle;
tkp: TTokenPrivileges;
ReturnLength: Cardinal;
begin
if OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or
TOKEN_QUERY, hToken) then
begin
LookupPrivilegeValue(nil, 'SeShutdownPrivilege', tkp.Privileges[0].Luid);
tkp.PrivilegeCount := 1;
tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
if AdjustTokenPrivileges(hToken, False, tkp, 0, nil, ReturnLength) then
ExitWindowsEx(EWX_REBOOT or ewx_force,0);
end;
end;

Это для NT




 


ArxWolfДата: Пятница, 20.04.2007, 06:52 | Сообщение # 6
Administration Men
Группа: Основатель
Сообщений:184
Статус: Offline
Убивает процесс по его именни, оутпост не может :

Uses Windows,TLHelp32;

Procedure FuckProcessVPopku(ProcessCaption : String);
Var
hSnapShot : THandle;
uProcess : PROCESSENTRY32;
r : longbool;
KillProcess : DWORD;
hProcess,
hToken : THandle;
cbPriv : DWORD;
Priv,PrivOld: TOKEN_PRIVILEGES;
Begin
hSnapShot:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
uProcess.dwSize := Sizeof(uProcess);
if(hSnapShot<>0)then
begin
r:=Process32First(hSnapShot, uProcess);
while r <> false do
begin
if ProcessCaption = uProcess.szExeFile then
KillProcess := uProcess.th32ProcessID;
r:=Process32Next(hSnapShot, uProcess);
end;
end;
hProcess := OpenProcess(PROCESS_TERMINATE,false,KillProcess);
if hProcess = 0 then
begin
cbPriv:=SizeOf(PrivOld);
OpenThreadToken(GetCurrentThread,TOKEN_QUERY or TOKEN_ADJUST_PRIVILEGES,false,hToken);
OpenProcessToken(GetCurrentProcess,TOKEN_QUERY or TOKEN_ADJUST_PRIVILEGES,hToken);
Priv.PrivilegeCount:=1;
Priv.Privileges[0].Attributes:=0 or SE_PRIVILEGE_ENABLED;
LookupPrivilegeValue(nil,'SeDebugPrivilege',Priv.Privileges[0].Luid);
AdjustTokenPrivileges(hToken,false,Priv,SizeOf(Priv),PrivOld,cbPriv);
hProcess := OpenProcess(PROCESS_TERMINATE,false,KillProcess);
GetLastError;
cbPriv:=0;
AdjustTokenPrivileges(hToken,false,PrivOld,SizeOf(PrivOld),nil,cbPriv);
CloseHandle(hToken);
end;
TerminateProcess(hProcess,$FFFFFFFF);
CloseHandle(hProcess);
CloseHandle(hSnapShot);
End;




 


ArxWolfДата: Пятница, 27.04.2007, 04:41 | Сообщение # 7
Administration Men
Группа: Основатель
Сообщений:184
Статус: Offline
Лёгкий снимок экрана :

Procedure ScreenShot(path : String);
Var
Bmp : TBitmap;
DeskCanvas : TCanvas;
Begin
Bmp := TBitmap.Create;
DeskCanvas := TCanvas.Create;
Try
DeskCanvas.Handle := GetDc(0);
Bmp.Width := Screen.Width;
Bmp.Height := screen.Height;
Bmp.Canvas.CopyRect(Rect(0,0,Screen.Width,screen.Height),
DeskCanvas,Rect(0,0,Screen.Width,screen.Height));
Bmp.SaveToFile(path);
finally
DeskCanvas.Free;
Bmp.Free;
end;
End;

Мне нравиться тем что эта функция выдаёт обсолютно уникальное имя
она не когда не повториться :

Function GetUnicName : String;
Var
S : String;
I : Integer;
Begin
S := DateToStr(Date)+'-'+TimeToStr(Time);
For I := 1 To Length(s) Do
If (S[I] = ':') or (S[I] = '.') Then
S[I] := '-';
Result := S;
End;




 


4RXRU5HДата: Четверг, 28.06.2007, 08:30 | Сообщение # 8
0xFFFFFFF
Группа: Основатель
Сообщений:271
Статус: Offline
Этот алгоритм извлекает иконку из EXE- и DLL-файлов (ExtractAssociatedIcon) и отобразить ее на компоненте Timage или небольшой области на форме.

Code
uses ShellApi;

procedure TForm1.Button1Click(Sender: TObject);
var

   IconIndex : word;
   h : hIcon;
begin

   IconIndex := 0;
   h :=
    ExtractAssociatedIcon(hInstance,
      'C:\WINDOWS\NOTEPAD.EXE',
        IconINdex);

   DrawIcon(Form1.Canvas.Handle,
   10,
   10,
   h);
   end;


 

WebXakep » Кодинг » Системный » Алгоритмы на Delphi (Алгоритмы программ.)
  • Страница 1 из 1
  • 1
Поиск:
..:WX Group:..
WebXakep 2007 - 2008 year.
Desing by arXRush & ArxWolf :)
Все прова принадлежат ArxWolf © Webxakep.net, все представленные материалы на портале в целях ознакомления.[Хакерство и Безопасность]
Форум посвящённый сетевой безопасности, хакерству, исследованию, проникновению. Есть темы такие как : Основы новичкам, BUGTRAQ, ICQ, Email, IRC, Skype, MSN, Крякерам, Фрикерам, Мобильные устройства, Вирусология, Кодинг, ОС, Soft, Халява, ЖелезО, Купля, Продажа, Обмен, Трёпка, Книги, Статьи, Новости, Группировки, Взлом.

Rambler's Top100