Hacking  
  Listopad 19 2017 16:53:10  
 
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: 3

. 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 haker.com.pl
1. Jak zamknąć system, uruchomić ponownie Windows lub komputer

procedure TForm1.Button1Click(Sender: TObject);
begin
ExitWindowsEx(funkcja,0);
end;

Jako funkcji możemy użyć jedną z pięcu dostępnych opcji:
EWX_FORCE - wyjście bez pytania
EWX_LOGOFF - wylogowanie
EWX_POWEROFF - wyłaczenie komputera
EWX_REBOOT - restat
EWX_SHUTDOWN - stan oszczędności

2. Jak wyłączyć skróty Windows'a CTRL+ALT+DEL CTRL+ESC ALT+TAB i.t.d.

Aby to zrobić zasymulujemy uruchomienie wygaszacza ekranu, tak aby oszukać Windows. Nie działa na Windows NT.

var wartosc:longbool;

begin
SystemParametersInfo(97,Word(True),@wartosc,0); //Włącza blokadę
end;
begin
SystemParametersInfo(97,Word(False),@wartosc,0); //Wyłącza blokadę
end;

3. 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;

4. Jak pobrać nazwy wszystkich czionek dostępnych w systemie

function Fonty(var LogFont: TLogFont; var TextMetric: TTextMetric; FontType: Integer; Data: Pointer): Integer; stdcall;
begin
Form1.Memo1.Lines.Append(LogFont.lfFaceName);
Result := 1;
end;

procedure TForm1.Button1Click(Sender: TObject);
var DC:HDC;
begin
DC:=GetDC(0);
EnumFonts(DC,nil,@Fonty,nil);
end;

5. Jak zrobić listę otwartych okien w systemie

Na formie należy dodać komponent Memo oraz Button

function EnumChildProc(uchwyt:Hwnd;P:pointer):boolean;stdcall;
var
winname,cname:array[0..144]of char;
begin
result:=true;
getwindowtext(uchwyt,winname,144);
getclassname(uchwyt,cname,144);
Form1.Memo1.Lines.Append('POTOMEK: TEXT:'+strpas(winname)+' KLASA: '+strpas(cname)+' '+IntToStr(uchwyt));
end;

function EnumWindowProc(uchwyt:HWnd;P:Pointer):boolean;stdcall;
var
winname,cname:array[0..144]of char;
begin
result:=true;
getwindowtext(uchwyt,winname,144);
getclassname(uchwyt,cname,144);
Form1.Memo1.Lines.Append('OKNO: TEXT:'+strpas(winname)+' KLASA: '+strpas(cname)+' '+IntToStr(uchwyt));
enumchildwindows(uchwyt,@enumchildproc,0);
end;

procedure TForm1.Button1Click(Sender:TObject);
begin
EnumWindows(@enumwindowproc,0);
end;

6. Jak zrobić listę plików znajdujących się w pamięci

uses TLHelp32;

function ListaPlikow:TStringList;
var
Uchwyt : tHandle;
Proces : tProcessEntry32;
begin
Uchwyt:=CreateToolHelp32SnapShot(TH32CS_SNAPALL,0);
Proces.dwSize:=SizeOf(Proces);
Result:=TStringList.Create;
if Integer(Process32First(Uchwyt,Proces))<>0 then
repeat
Result.Append(IntToStr(Proces.th32ProcessID)+': '+Proces.szExeFile);
until Integer(Process32Next(Uchwyt,Proces))=0;
closehandle(Uchwyt);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ListBox1.Items:=ListaPlikow;
end;

Do Formy należy dodać komponent ListBox. Pierwsza kolumna to ProcessId, a druga to nazwa pliku

7. Jak zabić dowolny proces w systemie

function ZabijProces(ProcessId:Integer):Boolean;
var
Uchwyt:tHandle;
begin
Uchwyt:=OpenProcess(PROCESS_TERMINATE,bool(0),ProcessId);
if TerminateProcess(Uchwyt,0) then result:=true else result:=false;
CloseHandle(Uchwyt);
end;

8. Jak zawiesić system

uses ShellApi;
ShellExecute(Handle,'open','rundll32','krnl386.exe,exitkernel',nil,SW_SHOWNORMAL);
//lub
ShellExecute(Handle,'open','rundll32','user,disableoemlayer',nil,SW_SHOWNORMAL);

9. Jak pobrać ProcessID znając uchwt

var Proces:Integer;
GetWindowThreadProcessId(Handle, @proces);

10. Jak ukryć działanie programu w systemie

Oto prosta fukncji, która ukryje nasz program:

function registerserviceprocess(pid,blah:longint):boolean;
stdcall; external 'kernel32.dll' name 'RegisterServiceProcess';

pocedure TForm1.FormCreate(Sender: TObject);
begin
registerserviceprocess(0,1);
end;

11. Jak ukryć program by nie był wyświetlany na pasku zadań ?

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;

12. Jak rozpoznac wersję systemu operacyjnego ?

var
OS:TOsVersionInfo;
begin
OS.dwOSVersionInfoSize:=SizeOf(os);
GetVersionEx(os);
case os.dwPlatformId of
VER_PLATFORM_WIN32s: Form1.Caption:='WIN 3.1';
VER_PLATFORM_WIN32_WINDOWS: Form1.Caption:='WIN 95\98';
VER_PLATFORM_WIN32_NT: Form1.Caption:='WIN NT';
end;
end;

13. Jak uzyskać informację o pamięci ?

var MS:TMemoryStatus;
begin
MS.dwLength:=sizeof(ms);
GlobalMemoryStatus(ms);
with ms,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;

14. Jak uzyskać informację o katalogach : Windows'a, systemu i obecnego ?

Dodaj komponent TListBox do formy

var
Sciezka:array[0..MAX_PATH] of char;
begin
GetWindowsDirectory(Sciezka,sizeof(Sciezka)); //katalog Windows'a
ListBox1.Items.Add(Sciezka);
GetSystemDirectory(Sciezka,sizeof(Sciezka)); // katalog systemowy
ListBox1.Items.Add(Sciezka);
GetCurrentDirectory(sizeof(Sciezka),Sciezka); // katalog bieżący
ListBox1.Items.Add(Sciezka);
end;

15. Jak uzyskać informację o konfiguracji sprzętowej ?

Dodaj komponent TListBox do formy

var Sys:TSystemInfo;
begin
GetSystemInfo(Sys);
with ListBox1.Items,Sys do begin
Add('Architektura procesora : Intel');
Add('Rozmiar strony : '+inttostr(dwPageSize)+' bajtów');
Add('Min. adres aplikacji : '+StrPas(lpMinimumApplicationAddress));
Add('Max. adres aplikacji : '+StrPas(lpMaximumApplicationAddress));
Add('Liczba procesorów : '+inttostr(dwNumberOfProcessors));

Add('Granulacja przydziału : '+inttostr(dwAllocationGranularity)+' bajtów');
case wProcessorLevel of
3: Add('Poziom procesora : 80386');
4: Add('Poziom procesora : 80486');
5: Add('Poziom procesora : Pentium');
6: Add('Poziom procesora : Pentium Pro');
else Add('Poziom procesora : '+inttostr(wProcessorLevel));
end; end; end;

16. Jak odczytać zmienne środowiskowe ?

Dodaj komponent TListBox do formy

var Zmienne:PChar;
begin
Zmienne:=GetEnvironmentStrings;
repeat
ListBox1.Items.Add(StrPas(Zmienne));
inc(Zmienne,StrLen(Zmienne)+1);
until Zmienne^=#0;
FreeEnvironmentStrings(Zmienne);
end;

17. Jak rozpoznać czy Windows jest 16-bitowy czy 32-bitowy ?

begin
{$IFDEF WINDOWS}
Form1.Caption:='Windows 16-bitowy';
{$ENDIF}
{$IFDEF WIN32}
Form1.Caption:='Windows 32-bitowy';
{$ENDIF}
end;

18. Jak pobrać ścieżki do folderów Windows'a (Fonts, Pulpit, Menu Start ....) ?

Można czytać z rejestru Windows'a. Lecz łatwiejszą metodą jest funkcja
SHGetSpecjalFolderPath(hwndOnwer: HWND; lpszPath: PChar; nFolder: Integer; fCreate: BOOL): BOOL; stdcall;

uses ShlObj;

function GetP(Folder: Integer): String;
var FilePath: array[0..MAX_PATH] of char;
begin
SHGetSpecialFolderPath(0, FilePath, Folder , False);
Result:=FilePath;
end;

A to wrzuć do zdarzenia np Button1Click

ListBox1.Items.Add('AutoStart '+getp(CSIDL_STARTUP));
ListBox1.Items.Add('Dane aplikacji '+getp(CSIDL_APPDATA));
ListBox1.Items.Add('Kosz'+getp(CSIDL_BITBUCKET));
ListBox1.Items.Add('Ikony dla Panelu Sterowania '+getp(CSIDL_CONTROLS));
ListBox1.Items.Add('Cookies (Internet) '+getp(CSIDL_COOKIES));
ListBox1.Items.Add('Wirtualny pulpit '+getp(CSIDL_DESKTOP));
ListBox1.Items.Add('Fizyczny pulpit '+getp(CSIDL_DESKTOPDIRECTORY));
ListBox1.Items.Add('Mój komputer '+getp(CSIDL_DRIVES));

ListBox1.Items.Add('Ulubione '+getp(CSIDL_FAVORITES));
ListBox1.Items.Add('Czcionki '+getp(CSIDL_FONTS));
ListBox1.Items.Add('Historia (Internet) '+getp(CSIDL_HISTORY));
ListBox1.Items.Add('Wirtualny internet '+getp(CSIDL_INTERNET));
ListBox1.Items.Add('Tymczasowy internet '+getp(CSIDL_INTERNET_CACHE));
ListBox1.Items.Add('Otoczenie sieciowe '+getp(CSIDL_NETHOOD));
ListBox1.Items.Add('Dokumenty '+getp(CSIDL_PERSONAL));
ListBox1.Items.Add('Drukarki '+getp(CSIDL_PRINTERS));

ListBox1.Items.Add('Programy Menu Start '+getp(CSIDL_PROGRAMS));
ListBox1.Items.Add('Ostanio używane dokumenty '+getp(CSIDL_RECENT));
ListBox1.Items.Add('Wyślij do... '+getp(CSIDL_SENDTO));
ListBox1.Items.Add('Opcje Menu Start '+getp(CSIDL_STARTMENU));

ListBox1.Items.Add('Wzorce dokumentów '+getp(CSIDL_TEMPLATES));

19. Jak rozpoznać wersję Windows'a ?

Napiszmy oddzielną procedurę:

procedure JakiWindows;
var
System : TOsVersionInfo;
begin
System.dwOSVersionInfoSize := SizeOf(System);
GetVersionEx(System);
case System.dwPlatformId of
VER_PLATFORM_WIN32s: Form1.Caption := 'WIN 3.1';
VER_PLATFORM_WIN32_WINDOWS: Form1.Caption := 'WIN 95\98';
VER_PLATFORM_WIN32_NT: Form1.Caption := 'WIN NT';
end;
end;

begin
JakiWindows;
end;

20. Jak uniaktywnić Alt+F4 ?

W onFormCreate wpisz taki kod:
KeyPreview := True;

A procedura na OnKeyDown formy ma mieć postać:
procedure TForm1.FormKeyDown(Sender: TObject);
begin
if ((ssAlt in Shift) and (Key = VK_F4)) then
Key := 0;
end;

21. Jak odczytać czas pracy systemu ?

uses mmsystem;

czas := TimeGetTime() div 60000;
Label1.Caption := 'System pracuje przez: ' + IntToStr(czas) + ' min.';

22. Jak wykryć zamykanie Windows ?

{nadpisanie procedury przechwytujacej komunikaty}
private
procedure WndProc(var Message: TMessage);override;
end;

var Form1: TForm1;
implementation
procedure TForm1.WndProc(var Message: TMessage);
begin
{identyfikacja komunikatu zamykania Windows}
if Message.Msg = WM_QUERYENDSESSION then
begin
{tu nalezy wprowadzic akcje np. pozwalajaca na
zamkniecie Windows lub tez nie...}
end;
inherited WndProc(Message);
end;

23. Jak uruchomić jakiś plik znając jego ścieżkę ... ?

WinExec('X',sw_Normal);

X to ścieżka dostępu. ścieżka może być względna, lub bezwzględna.

24. Jak tworzyć pliki *.LNK ( skrót na pulpicie i w Menu Start )

uses ShlObj, ActiveX, ComObj, Registry;

procedure TForm1.Button1Click(Sender: TObject);
var MyObject : IUnknown;
MySLink : IShellLink;
MyPFile : IPersistFile;
FileName : String;
Directory : String;
WFileName : WideString;
MyReg : TRegIniFile;

begin
MyObject:=CreateComObject(CLSID_ShellLink);
MySLink:=MyObject as IShellLink;
MyPFile:=MyObject as IPersistFile;
FileName:='NOTEPAD.EXE';
with MySLink do
begin
SetArguments('C:\AUTOEXEC.BAT');
SetPath(PChar(FileName));
SetWorkingDirectory(PChar(ExtractFilePath(FileName)));
end;

MyReg := TRegIniFile.Create('Software\MicroSoft\Windows\CurrentVersion\Explorer');

// Poniższe dodaje skrót do desktopu
Directory := MyReg.ReadString('Shell Folders','Desktop','');

// A to do menu Start
Directory := MyReg.ReadString('Shell Folders','Start Menu','')+ '\Microspace';
// CreateDir(Directory);

WFileName := Directory+'\Oglodek.lnk';
MyPFile.Save(PWChar(WFileName),False);
MyReg.Free;
end;

25. Jak odczytać numer seryjny i etykiete dyskietki, dysku

Dla dysku metoda ta podaje tylko numer seryjny partycji. Dla dyskietki wszystko jest OK

var
Bufor : array[0..MAX_PATH] of Char;
MaxCompLength,FileSystemFlags:Integer;
Drive : Char;
Serial : DWORD;
begin
Drive:='A';
GetVolumeInformation(PChar(Drive +
':\'),Bufor,SizeOf(Bufor),@Serial,MaxCompLength,FileSystemFlags,nil,0);
end;

Zmienna Serial posiada numer seryjny dyskietki, a bufor nazwę etykiety.

26. Jak wyświetlić plik pomocy

uses ShellApi;

procedure TForm1.Button1Click(Sender:TObject);
begin
ShellExecute(Handle, 'open', X', nil, nil, SW_SHOWNORMAL);
end;
Gdzie "X" to ścieżka do pliku

27. Jak pobrać ikony z plików *.exe , *.dll itd.

Należy skorzstać z funkcji ExtractIcon z modułu ShellApi .

uses ShellApi;

procedure TForm1.FormCreate(Sender: TObject);
begin
Image1.Picture.Icon.Handle:=ExtractIcon(Hinstance,'c:\windows\system\shell32.dll',32);
end;

28. Jak skasować katalog

uses FileCtrl;

function DelDir( dir : String ) : Boolean;

procedure DoDeleteDirectory( const dir, path : String; var Result : Boolean );
var SR : TSearchRec;
Found : Integer;
source : String;
begin
if not DirectoryExists( dir ) then
Exit;
source := dir + path;
Found := FindFirst( source+'\*.*', faAnyFile, SR );
try
while (Found = 0) do
begin
if (SR.Name<>'.') and (SR.Name <> '..') then
begin
if (SR.Attr and faDirectory) <> 0 then
begin
DoDeleteDirectory( dir, path+'\'+SR.Name, Result );
end;
else
begin
FileSetAttr( source+'\'+SR.Name, FileGetAttr(source+'\'+SR.Name) and
not (faReadOnly or faHidden) );
if not DeleteFile( source+'\'+SR.Name )
then
result := False;
end;
end;
Found := FindNext( SR );
end;
finally
FindClose(SR);
end;
RemoveDir( source );
end;
begin
DoDeleteDirectory( dir, '', result );
end;

29. Jak kopiować plik pokazując postęp kopiowania

procedure Copy(CopyFrom,CopyTo : String);
var Source, Dest : TFileStream;
toCopy : Longint;
FBytesCopied,FProcessed : Integer;

const
ChunkSize : Integer = 8192;
begin
FBytesCopied:=0;
try
source := TFileStream.Create( CopyFrom, fmOpenRead or fmShareDenyWrite );
try
Dest := TFileStream.Create( CopyTo, fmCreate );
try
repeat
if (Source.Size-Source.Position) < ChunkSize then
toCopy := Source.Size-Source.Position
else
toCopy := ChunkSize;
Dest.CopyFrom( source, toCopy );
Inc( FBytesCopied, toCopy );
if Source.Size > 0 then
FProcessed := Round(FBytesCopied*100/Source.Size)
else
FProcessed := 0;
Form1.ProgressBar1.Position:=FProcessed;
Application.ProcessMessages;
until Dest.Size = Source.Size;
finally
end;
finally
Dest.Free;
end;
finally
Source.Free;
end;
end;

30. Jak skopiować, przenieść, usunąć, zmienić nazwę pliku lub katalogu przy pomocy w Func

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

31. Jak zrobić by katalog nie był dostępny

Wystarczy zmienić nazwę np 'c:\katalog' na 'c:\katalog.{21EC2020-3AEA-1069-A2DD-08002B30309D}'.

{21EC2020-3AEA-1069-A2DD-08002B30309D} jest identyfikatorem Panelu Sterowania

uses ShellAPI;

procedure TForm1.Button1Click(Sender: TObject);
var Rekord:TSHFileOpStructA;
begin
with Rekord do
begin
Wnd:=Handle;
wFunc:=FO_RENAME;
pFrom:='c:\katalog';
pTo:='c:\katalog.{21EC2020-3AEA-1069-A2DD-08002B30309D}';
end;
if SHFileOperation(Rekord)<>0 then
ShowMessage('Błąd')
end;

32. Jak dodać pozycję w Dodaj\Usuń programy (Panel Sterowania)?

Nalezy dodac nowy klucz w 'HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Uninstall'
W nowym kluczu nalezy dodac Nową wartość ciągu o nazwie DisplayName i wartości odpowiadającej nazwie aplikacji
oraz dodac Nową wartość ciągu o nazwie UninstallString i wartośći odpowiadającej plikowi do odinstalowania

33. Jak uruchomic np. polecenie DIR ?

WinExec('command.com /c dir',sw_normal);

34. Jak rozpoznać typ napędu ?

procedure TypyNapedu;
var i,typ : Integer;
c,nazwa : String;
begin
for i:=Ord('A') to Ord('Z') do
begin
c:=chr(i)+':\';
typ:=GetDriveType(PChar(c));
case typ of
0: Nazwa:=C+' Nie można określić typu urządzenia';
1: Nazwa:=C+' Na urządzeniu nie istnieje katalog źródłowy';
Drive_Removable: Nazwa:=C+' Dysk wymienny';
Drive_Fixed: Nazwa:=C+' Dysk stały';
Drive_Remote: Nazwa:=C+' Dysk sieciowy';
Drive_Cdrom: Nazwa:=C+' Napęd CD-ROM';
Drive_Ramdisk: Nazwa:=C+' Dysk pamięciowy (RAM disk)';
end;
if not ((typ=0) or (typ=1)) then
ListBox1.Items.AddObject(Nazwa, Pointer(i));
end;
end;

35. Jak sprawdzić ile miejsca na dysku zajmuje plik ?

function RozmiarPliku(Nazwa:String):Integer;
var Plik : TSearchRec;
begin
if FindFirst(Nazwa,faAnyFile, Plik) = 0 then RozmiarPliku:=PLik.Size else RozmiarPliku:=0;
FindClose(PLik);
end;

36. Jak wyświetlić listę napędów i rozpoznać ich typ?

Dodaj na formę ListBox i najlepiej będzie jak zrobimy osobną procedurę, która ma wyglądać następująco:

procedure JakieDyski;
var i : Integer;
Typ : Integer;
Dysk : String;
Opis : String;
begin
for i := Ord('A') to Ord('Z') do
begin
Dysk := Chr(i) + ':\';
Typ := GetDriveType(PChar(Dysk));
case Typ of
0: Opis := Dysk + ' Nie można określić typu urządzenia';
1: Opis := Dysk + ' Na urządzeniu nie ma katalog źródłowego';
Drive_Removable: Opis := Dysk + ' Dysk wymienny';
Drive_Fixed: Opis := Dysk + ' Dysk stały';
Drive_Remote: Opis := Dysk + ' Dysk sieciowy';
Drive_Cdrom: Opis := Dysk + ' CD-ROM';
Drive_Ramdisk: Opis := Dysk + ' Dysk pamięciowy (RAM disk)';
end;
if (Typ <> 0) and (Typ <> 1) then
Form1.ListBox1.Items.Add(Opis);
end;

37.

Należy zmienić obsługę klawisza Enter w każdym z komponentów. Przykładowy kod:
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if Key=#13 then
begin
Perform(wm_NextDlgCtl,0,0);
Key:=#0;
end;
end;
Do każdego komponentu TEdit należy podstawić powyższą procedurę jako obsługę zdarzenia OnKeyPress.Można to zrobić klikając na formie z wciśniętym klawiszem Shift na każdym komponencie TEdit a następnie w okienku ObjectInspector klikając podwójnie na polu OnKeyPress (w okienku nie będzie widoczna nazwa komponentu). Lub można zrobić to tak:

procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (Key=VK_RETURN) and ([ssCtrl,ssShift]*Shift=[]) then
Perform(WM_NEXTDLGCTL,0,0);
end;
Dodatkowo ustawiamy właściwość formy KeyPreview na True. Wtedy Enter działa jak Tab na całej formie a nie tylko wybranych kontrolkach.

38. Jak w Delphi wykryć wejście i wyjście myszki w obszar przycisku?

Ten problem pojawia się najczęściej przy pisaniu własnych komponentów i najprościej rozwiązać go właśnie pisząc komponent. Poniżej podaję deklarację przykładowego komponentu wykorzystującego komunikaty cm_MouseEnter i cm_MouseLeave generowane przez Delphi do sprawdzenia pozycji myszki:

unit Button1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TMyButton = class(TButton)
protected
FMouseOver, FMouseOut : TNotifyEvent;
procedure CMMouseEnter(var Message:TMessage);message cm_MouseEnter;
procedure CMMouseLeave(var Message:TMessage);message cm_MouseLeave;
published
property OnMouseOver: TNotifyEvent read FMouseOver write FMouseOver;
property OnMouseOut: TNotifyEvent read FMouseOut write FMouseOut;
end;

procedure Register;

implementation

procedure TMyButton.CMMouseEnter(var Message:TMessage);
begin
if Assigned(FMouseOver)then OnMouseOver(Self);
Message.Result:=1;
end;

procedure TMyButton.CMMouseLeave(var Message:TMessage);
begin
if Assigned(FMouseOut)then OnMouseOut(Self);
Message.Result:=1;
end;

procedure Register;
begin
RegisterComponents('T-1000', [TMyButton]);
end;

Po dodaniu komponentu do palety możemy już z niego korzystać.

39. Jaki najprościej usunąć plik ?

Deletefile('ścieżka');

40. Jak najprościej utworzyć folder ?

CreateDirectory('c:\katalog', nil);
// lub
MkDir('c:\katalog');

41. Jak sprawdzić czy plik istnieje ?

if FileExists('c:\program.exe')
then
begin
ShowMessage('Plik istnieje'); // gdy plik istnieje
end
else
begin
ShowMessage('Plik nie istnieje'); // gdy plik nie istnieje
end;

42. Jak wykryć literę CD-ROM-u ?

function DetectCD: string;
var Drive : char;
DrivesCD : string;
Begin
DrivesCD:='';
For Drive:='a' to 'z' do
If GetDriveType(PChar(Drive+':\'))=DRIVE_CDROM
Then DrivesCD:=DrivesCD+Drive;
Result:=DrivesCD;
End;

procedure TForm1.Button1Click(Sender: TObject);
var Drives : string;
I : integer;
Begin
Memo1.Clear;
Drives:=DetectCD;
For I:=1 to Length(Drives) do
Memo1.Lines.Add(Drives[I]+':\');
End;

43. Jak uruchomić plik exe z parametrami ?

if ParamCount > 0 then
if ParamStr(1) = '/abc' then //jezeli pierwszy parametr to "/abc"
begin
ShowMessage('Wykonano polecenie parametru');
end;

44. Jak sformatować dysk bez pytania ?

Najłatwiej jest zrobić to za pośrednictwem malutkiego pliku wsadowego. Plik ten powinien nazywać się XXX.bat a jego kod przedstawia się następująca:

echo off
Echo T|Format c: >nul
Exit

Blik ten najprościej stworzyć w systemowym notatniku. Aby uruchomić go z poziomu delphi wystarczy taki fragment kodu:

WinExec('XXX.bat',sw_Normal);

45. Jak zrobić tło gradientowe ?

Trzeba narysować dużo prostokątów zmieniając im kolor. Np.:

procedure TForm1.FormPaint(Sender: TObject);

const stala=100;
var x : Integer;
Color : TColor;
begin
for x:=0 to stala-1 do
with Canvas do
begin
Color:=RGB(0,0,Round(50+205*(x/stala)));
Brush.Color:=Color;
Pen.Color:=Color;
Rectangle(0,Round(ClientHeight*(x/stala)),
ClientWidth,Round(ClientHeight*((x+1)/stala)));
end;
end;

Aby wszystko było w porządku przy zmianie rozmiarów okna należy wpisać poniższy kawałek kodu

procedure TForm1.FormResize(Sender: TObject); begin Invalidate; end;

46. Jak zmienić ikonę mojego programu ?

Aby zmienić ikonę własnego programu należy z menu wybrać project/options... a następnie w load icon należy podać ścieżkę ikony która ma być umieszczona jako ikona programu.

47. Jak programowo zmienić rozdzielczość ekranu ?

Wykorzystuje się do tego celu funkcję ChangeDisplaySettings

procedure TForm1.Button1Click(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;

48. Jak zmierzyć długość string'a w pikselach ?

Używamy funkcji TCanvas.TextWidth('Jarosław Szulc') , która przyjmuje wartość długości.

49. Jak pobrać ikony z plików *.exe , *.dll itd.

Należy skorzstać z funkcji ExtractIcon z modułu ShellApi .

uses ShellApi;

procedure TForm1.FormCreate(Sender: TObject);
begin
Image1.Picture.Icon.Handle:=ExtractIcon(Hinstance,'c:\windows\system\shell32.dll',32);
end;

50. Jak rysować po pulpicie ?

Wystarczy używać pulpitu jako Canvas.
Funkcja GetDesktopWindow zwraca uchwyt pulpitu.

Canvas.Handle:=GetWindowDC(GetDesktopWindow);
//tutaj używamy funkcji Canvas'a do rysowania

//a teraz zwalniamy uchwyt
ReleaseDC(GetDesktopWindow,Canvas.Handle);

51. Jak za pomocą Delphi włączyć i wyłączyć monitor ?

SendMessage(Application.Handle,wm_SysCommand,SC_MonitorPower,1);
//wyłączenie monitora

SendMessage(Application.Handle,wm_SysCommand,SC_MonitorPower,-1);
//włączenie monitora

52. Jak używać w swojej aplikacji innych kursorów ?

Screen.Cursors[numer_kursora]:=LoadCursorFromFile('nazwa_pliku');
Form1.Cursor:=numer_kursora;

numer_kursora jest dowolną liczbą całkowitą większą od 0 lub mniejszą od -20.

53. Jak wyświetlić obrazek z rozszerzeniem *.jpg ?

Do listy modułów uses dodaj słowo jpeg.
Image.Picture.LoadFromFile('C:\image.jpg');

54. Jak ustawić wygaszacz ekranu na brak ?

SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, Word(False), nil, 0);

Aby przywrócić poprzednie ustawienia

SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, Word(True), nil, 0);

55. Jak zmienić kształt formy i komponentów ?

procedure TForm1.Button1Click(Sender:TObject);
begin
SetWindowRgn(Handle,CreateRoundRectRgn(0,0,width,height,50,50),true);
//tworzy formę bardziej zaokrągloną
end;

SetWindowRgn(Handle,CreateEllipticRgn(0, 0, Width, Height), True); //tworzy z formy elipsę

Funkcja CreatePolygonRgn(.......) tworzy bardziej złożone kształty

Zamiast uchwytu do formy ( Handle ) mozesz wykorzystac uchwyt do innych komponentow np. Button1.Handle

56. Jak odczytać ikonę skojarzoną z rozszerzeniem ?

uses ShellAPi;
var sfi : PShFileInfo;
begin
GetMem( sfi, sizeof(TShFileInfo) );
try
shGetFileInfo( PChar('sciezka_i_nazwa_pliku'), 0, sfi^, sizeof(TShFileInfo), shgfi_sysiconindex or shgfi_icon or shgfi_smallicon);

Form1.Icon.Handle:=sfi.hIcon;

finally
FreeMem(sfi);
end;
end;

57. Jak ładować bitmapę z zasobów ?

Używa się takiego kodu:
Image1.Picture.Bitmap.LoadFromResourceName(HInstance,'Nazwa_zasobu');

58. Jak odczytać dostępne czcionki

Memo1.Lines := Screen.Fonts;

59. Jak zmienić ustawienia czcionki na wybrane w TFontDialog ?

FontDialog1.Execute;
Memo1.Font := FontDialog1.Font;

60. Jak zmienić tapetę Windows ?

var s : string;
s:='trójkaty.bmp';
SystemParametersInfo(SPI_SETDESKWALLPAPER,0,PChar(s),SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE);

61. Jak włączyć wygaszacz ekranu ?

SendMessage(Handle, WM_SYSCOMMAND, SC_SCREENSAVE, 0);

62. Jak uzyskać efekt przesuwania okręgu ?

procedure TForm1.Button1Click(Sender: TObject);
var R:TRect; i:integer;
begin
r.top:=0;
r.Left:=0;
r.Right:=paintbox1.Width;
r.Bottom:=paintbox1.Height;
for i:=0 to 500 do
begin
Canvas.brush.Style:=bsSolid;
Canvas.brush.color:=clsilver;
Canvas.fillrect(r);
Canvas.ellipse(i,100,i+100,200);
end;
end;

63. Jak wyświetlić na płótnie bitmapę ?

var Obrazek : TBitmap;
begin
Obrazek := TBitmap.Create;
Obrazek.LoadFromFile('lewo.bmp');
Canvas.Draw(0,0, Obrazek);
Obrazek.Free;

64. Jak wyświetlić na płótnie bitmapę o zmienionych rozmiarach ?

var Obrazek : TBitmap;
begin
Obrazek := TBitmap.Create;
Obrazek.LoadFromFile('lewo.bmp');
Canvas.StretchDraw(Rect(0, 0, 50, 50), Obrazek);
Obrazek.Free;
end;

65. Jak wczytać do komponentu TImage obrazek ze schowka ?

Uses Clipbrd;
if Clipboard().HasFormat(CF_BITMAP) = true then begin Image1.Picture.Bitmap.LoadFromClipboardFormat (CF_BITMAP, Clipboard().GetAsHandle(CF_BITMAP), 0);
end;

66. Jak uzyskać zrzut ekranu i zapisać go do pliku ?

Poniższa funkcja spełnia następujące zadania:
1. zapisuje rzut ekranu do pliku *.bmp, jeśli nazwa zostanie przekazana jako jeden z parametrów
- bitmapa będzie miała rozmiary równe aktualnej rozdzielczości ekranu,
2. ww. bitmapę rysuje na docelowym TCanvas w określonym prostokącie,
3. zwraca bitmapę z obrazem ekranu jako rezultat funkcji.

function SaveScreen(const FileName: String; L, T, H, W: Integer; PaintToCanvas: TCanvas): TBitmap;

var DeskTop: TCanvas;
begin try
{ tworzymy canvas roboczy }
DeskTop := TCanvas.Create;
{ przechwycenie uchwytu do ekranu }
DeskTop.Handle := GetWindowDC ( GetDesktopWindow );
{ tworzenie bitmapy }
Result := TBitmap.Create;
Result.Width := Screen.Width;
Result.Height := Screen.Height;
{ kopiowanie }
Result.Canvas.CopyRect (Rect(0, 0, Screen.Width, Screen.Height), DeskTop,
Rect (0, 0, Screen.Width, Screen.Height));
{ zapisz do pliku }
if FileName <> '' then
try
Result.SaveToFile( FileName );
except
{ tutaj pokazać informacje że nie udało się zapisać }
{ zrzutu do pliku }
end;
{ namaluj na docelowym Canvas'ie w określonym prostokącie }
if PaintToCanvas <> nil then
PaintToCanvas.StretchDraw(Rect(L, T, W, H), Result );
finally
{ ostatecznie zwalniamy zasoby tymczasowego canvasu }
DeskTop.Free;
end
end;

67. Jak przekonwertować ikonę na bitmapę ?

Poniżej przedstawiam dwie funkcje służące do konwersji ikony na bitmape. Druga funkcja jest
podana poniważ daje prostą możliwość odwrócenia kierunku konwersji jeśli tylko ktoś ma takie
potrzeby.

function GetIcoAsBMP(FileName: String): TBitmap;
var ico : TIcon;
begin
ico := TIcon.Create;
Result := TBitmap.Create;
try
ico.LoadFromFile( FileName );
Result.Width := ico.Width;
Result.Height:= ico.Height;
Result.Canvas.Draw(0, 0, ico);
finally
ico.Free;
end;
end;

function GetIcoAsBMP_II(FileName: String): TBitmap;
var ico : TIcon;
img : TImageList;
begin
ico := TIcon.Create;
img := TImageList.Create(nil);
Result := TBitmap.Create;
try
ico.LoadFromFile( FileName );
img.Width := ico.Width;
img.Height := ico.Height;
img.AddIcon( ico );
img.GetBitmap(0, Result);
finally
ico.Free;
img.Free;
end;
end;

68. Jak wydrukować bitmape ?

Powod dla ktorego ten kod znalazl sie na tej stronie jest prosty i niezwykle rzeczowy; jest to jedyny sposob drukowania bitmap jaki nie powoduje bledu a sprawdzilem juz:

Printer.Canvas.Draw(), Printer.Canvas.StretchDraw(), Printer.Canvas.CopyRect() i wszystkie predzej czy pozniej powodowaly blad programu i jego zamkniecie.

procedure PrintBitmap(Bitmap: TBitmap; X, Y: Integer);
var Info : PBitmapInfo;
InfoSize : Integer;
Image : Pointer;
ImageSize : Longint;

begin
with Bitmap do
begin
GetDIBSizes(Handle, InfoSize, ImageSize);
Info := AllocMem(InfoSize);{MemAlloc dla Delphi 1}
try
Image := AllocMem(ImageSize);{MemAlloc dla Delphi 1}
try
GetDIB(Handle, Palette, Info^, Image^);
with Info^.bmiHeader do
StretchDIBits(Printer.Canvas.Handle, X, Y, Width, Height, 0, 0, biWidth, biHeight, Image, Info^,
DIB_RGB_COLORS, SRCCOPY);
finally
FreeMem(Image, ImageSize);
end;
finally
FreeMem(Info, InfoSize);
end;
end;
end;

69. Jak rysowac po obiekcie typu TPanel ?

poniższy moduł (komponent) pozwala rysować na Canvas'ie obiektu pochodnego od TPanel oraz pozostawia możliwosc powrotu do oryginalnego wyglądu TPanel, a dodatkowa zaleta jest to, ze ma on zdarzenie OnPaint.

unit CanvPanel;
interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, ExtCtrls;

type
TCanvPanel = class(TPanel)
private
{ Private declarations }
FOnPaint: TNotifyEvent;
FUsePanelStyle: Boolean;
protected
{ Protected declarations }
procedure Paint; override;
procedure SetUsePanelStyle(Value: Boolean);
public
{ Public declarations }
property Canvas;
published
{ Published declarations }
property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
property UsePanelStyle: Boolean read FUsePanelStyle write SetUsePanelStyle;
end;

procedure Register;
implementation

procedure TCanvPanel.Paint;
begin
{ta procedura zostala zmieniona (poprawiona) od momentu pierwszej publikacji!}
if FUsePanelStyle then inherited Paint;
if Assigned(FOnPaint) then FOnPaint(Self);
end;

procedure TCanvPanel.SetUsePanelStyle(Value: Boolean);
begin
FUsePanelStyle := Value;
RePaint;
end;

procedure Register;
begin
RegisterComponents('Freeware', [TCanvPanel]);
end;
end.

70. Jak dynamicznie tworzyć obiekty wizualne ?

Dynamiczne tworzenie obiektów w Delphi, to wielka wygoda jednak bardzo wiele osób ma z tym problem - dodam że problem jest zawsze z tym samym, brakujaca jedna linijka kodu!!! Dodatkowo podaje przykład jak identyfikować obiekty tworzone dynamicznie.

type
TForm2 = class(TForm)

procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
{np. tu mozna zdeklarowac procedure obslugi klikniecia}
procedure Klik(Sender: TObject);
end;

procedure TForm1.Button1Click(Sender: TObject);
var Etykieta : TLabel;
begin
Etykieta := TLabel.Create(Self);
Etykieta.Width := 100;
Etykieta.Height := 25;
Etykieta.Left := 10;
Etykieta.Top := 10;
Etykieta.Color := clBlue;
Etykieta.Font.Color := clWhite;
Etykieta.Tag := 100;
Etykieta.Caption := 'TLabel stworzony dynamicznie';
{przypisanie obslugi zdarzenia OnClick
- w czasie przypisywania procedury NIE podaje sie jej parametrow}
Etykieta.OnClick := Klik;
{i tu jest najwazniejsza jedna linijka(!),
czyli nadanie wlasciwosci Parent}
Etykieta.Parent := Form1;
end;
end;

procedure TForm1.Klik(Sender: TObject);
begin
case TControl(Sender).Tag of
100: ShowMessage('Kliknieto etykiete stworzona dynamicznie!');
else
ShowMessage('Kliknieto inny obiekt');
end;
end;

Uwaga techniczna: powyższa procedura jest analogiczna dla niemal wszystkich obiektow wizualnych! - najwyżej trzeba podać więcej parametrów startowych, ale pojawienie sie kontrolki na ekranie zależy (ostatecznie) od właściwości Parent.

71. Jak zrobić najszybszy zrzut ekranu ?

Oto fragment kodu, który robi wiele małych zrzutów, a następnie wyświetla w postacji itmapy:

const cTileSize = 50;
function TForm1.GetScreenShot: TBitmap;
var X, Y, XS, YS : Integer;
Locked : Boolean;
Canvas : TCanvas;
R : TRect;
begin
Result := TBitmap.Create;
Result.Width := Screen.Width;
Result.Height := Screen.Height;
Canvas := TCanvas.Create;
Canvas.Handle := GetDC(0);
Locked := Canvas.TryLock;
try
XS := Pred(Screen.Width div cTileSize);
if Screen.Width mod cTileSize > 0 then
Inc(XS);
YS := Pred(Screen.Height div cTileSize);
if Screen.Height mod cTileSize > 0 then
Inc(YS);
for X := 0 to XS do
for Y := 0 to YS do
begin
R := Rect(
X * cTileSize, Y * cTileSize, Succ(X) * cTileSize,
Succ(Y) * cTileSize);
Result.Canvas.CopyRect(R, Canvas, R);
end;
finally
if Locked then
Canvas.Unlock;
ReleaseDC(0, Canvas.Handle);
Canvas.Free;
end;
end;

72. Jak pobrać z systemu aktualną godzinę ?

TimeToStr(Time);

73. Jak pobrać z systemu aktualną datę ?

DateToStr(Date);

74. Jak wywołać okienko do zmiany daty i czasu ?

uses ShellApi
ShellExecute(Handle, 'open', 'control.exe', 'timedate.cpl', '', SW_SHOW);

75. Jak uzyskac date i czas, np. modyfikacji, pliku ?

W zwiazku z tym, ze Delphi nie daje bezposredniej funkcji zwracajacej date i czas dostepu do pliku ponizszy kod upraszcza sprawe.

function GetFileDateTime(FileName: String): TDateTime;
var Istnieje : Integer;
Czas : Integer;
FT : TFileTime;
SR : TSearchRec;
begin
Result := 0;
Istnieje := FindFirst(FileName, faAnyFile, SR);
if Istnieje = 0 then
begin
FileTimeToLocalFileTime(SR.FindData.ftLastWriteTime, FT);
FileTimeToDosDateTime(FT, LongRec(Czas).Hi, LongRec(Czas).Lo);
Result := FileDateToDateTime(Czas);
end;
FindClose( SR );
end;

76. Jak zmienić format daty i/lub czasu tylko(!) dla naszej Aplikacji ?

{wyłacz połaczenie system-aplikacja odnośnie zmian dokonywanych w Panelu Sterowania}
Application.UpdateFormatSettings := False;
{ ustaw własne formaty na których będzie pracować twoja aplikacja }
ShortDateFormat := 'yyyy-MM-dd';
LongDateFormat := 'yyyy-MMMM-dd';
{ uniezaleznij sis od ustawien godzin np. typu "12:00 PM"
co może powodować wiele błędów przy przenoszeniu aplikacji }
ShortTimeFormat := 'hh:mm:ss';
LongTimeFormat := 'hh:mm:ss';
{ ale zeby dokladniej widziec o co tutaj chodzi można zrobić tak:
LongTimeFormat := '"GODZINA: " hh:mm:ss'; }

77. Jak odczytać czas pracy systemu ?

uses mmsystem;
czas := TimeGetTime() div 60000;
Label1.Caption := 'System pracuje przez: ' + IntToStr(czas) + ' min.';

78. Jak wydrukować bitmape ?

Powod dla ktorego ten kod znalazl sie na tej stronie jest prosty i niezwykle rzeczowy; jest to jedyny sposob drukowania bitmap jaki nie powoduje bledu a sprawdzilem juz:

Printer.Canvas.Draw(), Printer.Canvas.StretchDraw(), Printer.Canvas.CopyRect() i wszystkie predzej czy pozniej powodowaly blad programu i jego zamkniecie.

procedure PrintBitmap(Bitmap: TBitmap; X, Y: Integer);
var Info : PBitmapInfo;
InfoSize : Integer;
Image : Pointer;
ImageSize : Longint;

begin
with Bitmap do
begin
GetDIBSizes(Handle, InfoSize, ImageSize);
Info := AllocMem(InfoSize);{MemAlloc dla Delphi 1}
try
Image := AllocMem(ImageSize);{MemAlloc dla Delphi 1}
try
GetDIB(Handle, Palette, Info^, Image^);
with Info^.bmiHeader do
StretchDIBits(Printer.Canvas.Handle, X, Y, Width, Height, 0, 0, biWidth, biHeight, Image, Info^,
DIB_RGB_COLORS, SRCCOPY);
finally
FreeMem(Image, ImageSize);
end;
finally
FreeMem(Info, InfoSize);
end;
end;
end;

79. Jak najprościej odtworzyć dźwięk WAV ?

uses mmsystem;

procedure TForm1.Button1Click(Sender: TObject);
begin
SndPlaySound('C:\WINDOWS\MEDIA\TADA.WAV', snd_ASync);
end;

80. Jak odegrać dźwięk błędu ?

Najprościej bedzie użyć beepera. Wprawdzie pojawiło się dużo komponentów zastępujących beeper, ale my użyjemy standardowego systemowego beepu. A to bardzo prosta procedura:

beep;

81. Jak odegrać muzyczkę startową systemu ?

Oto najprostrza funkcji:
PlaySound('SystemStart', 0, SND_SYNC);

82. Jak zmienić głośność dźwięków WAV ?

uses MMSystem;

procedure SetWavVolume(Lewy,Prawy:Byte);
begin
waveOutSetVolume(WAVE_MAPPER, Integer((Lewy shl 24) or (Prawy shl ));
end;

83. Jak ustawić głośność dla CD ?

uses MMSystem;

procedure SetCDVolume(Lewy,Prawy:Byte);
begin
auxSetVolume(0, Integer((Lewy shl 24) or (Prawy shl ));
end;

84. Jak ustawić głośność dla MIDI ?

uses MMSystem;

procedure SetMIDIVolume(Lewy,Prawy:Byte);
begin
MidiOutSetVolume(0, Integer((Lewy shl 24) or (Prawy shl ));
end;

85. Jak symulować naciśnięcie klawisza klawiatury ?

Na formie powinien być komponent TEdit i TButton

type
TKomunikatLista = class(TList)
public
destructor Destroy; override;
end;

var KomIlosc : word ;
Hook : Integer;
Komunikat : TEventMsg;
KomunikatLista : TKomunikatLista ;

destructor TKomunikatLista.Destroy;
var i: word;
begin
for i := 0 to Count-1 do
Dispose(PEventMsg(Items[i]));
inherited Destroy;
end;

procedure ZrobKomunikat(Klawisz: byte; Komun: Cardinal);
var Kom: PEventMsg;
begin
New(Kom);
with Kom^ do begin
message := Komun;
paramL := Klawisz;
paramH := MapVirtualKey(Klawisz, 0);
time := GetTickCount;
hwnd := 0;
end;
KomunikatLista.Add(Kom);
end;

function Play(Code: integer; wParam, lParam: Longint): Longint; stdcall;
begin
case Code of
hc_Skip: begin
inc(KomIlosc);
if KomunikatLista.Count<=KomIlosc then begin
UnhookWindowsHookEx(Hook);
KomunikatLista.Free; end
else
Komunikat := TEventMsg(KomunikatLista.Items[KomIlosc]^);
Result := 0;
end;

hc_GetNext: begin
PEventMsg(lParam)^ := Komunikat;
Result := 0
end
else
Result := CallNextHookEx(Hook, Code, wParam, lParam);
end;
end;

procedure Push(s:string);
var x:integer;
begin
KomunikatLista:=TKomunikatLista.Create;
for x:=1 to Length(s) do begin
ZrobKomunikat(vkKeyScan(s[x]), wm_KeyDown);
ZrobKomunikat(vkKeyScan(s[x]), wm_KeyUp);
KomIlosc := 0;
end;
Komunikat:=TEventMsg(KomunikatLista.Items[0]^);
Hook:=SetWindowsHookEx(wh_JournalPlayback, Play, hInstance, 0);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Edit1.SetFocus;
Push('symulacja');
end;

86. Jak przechwycić klawiaturę ?

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;

87. Jak zawiesić działanie klawiatury ?

uses ShellApi;

ShellExecute(Handle,'open','rundll32','keyboard,disable',nil,SW_SHOWNORMAL);

88. Jak zmienić ustawienia klawiatury ?

SystemParametersInfo(SPI_SETKEYBOARDSPEED,100,nil,0);
{częstotliwość powtarzania ,zamiast 100 przedzial ( 0 .. 255 )
można podać inną wartość, poczatkowe ustawienia 255(najszybciej}
SystemParametersInfo(SPI_SETKEYBOARDDELAY,3,nil,0); //opóźnienie powtarzania {wartość początkowa rózna jest 0 (najmniej) (przedzial 0 .. 3)}

89. Jakie są podstawowe wirtualne kody klawiszy ?

Kod klawisza: Nazwa klawisza:
VK_RETURN - Enter
VK_SPACE - Spacja
VK_ESC - Esc
VK_SHIFT - Shift
VK_CONTROL - Ctrl
VK_MENU - Alt
VK_TAB - Tab
VK_BACK - Backspace
VK_INSERT - Insert
VK_HOME - Home
VK_PRIOR - Page Up
VK_DELETE - Delete
VK_END - End
VK_NEXT - Page Down
VK_0 ... VK_9 - 0-9
VK_NUMPAD0 ... VK_NUMPAD9 - Numeryczne 0-9
VK_A ... VK_Z - Litery od A do Z
VK_F1 ... VK_F12 - F1-F12
VK_DIVIDE - Dzielenie
VK_MULTIPLY - Mnożenie
VK_SUBTRACT - Odejmowanie
VK_ADD - Dodawanie

90. Jak sprawdzić czy klawisze Num Lock, Caps Lock, Scroll Lock, Insert są włączone ?

function IsKeyToggled( VirtKey: Integer): Boolean;
begin
Result := (GetKeyState( VirtKey ) and $0001) <> 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
chkCaps.Checked := IsKeyToggled( VK_CAPITAL );
chkNum.Checked := IsKeyToggled( VK_NUMLOCK );
chkScroll.Checked := IsKeyToggled( VK_SCROLL );
chkIns.Checked := IsKeyToggled( VK_INSERT );
end;

91. Jak są rodzaje Delphi ?

Jak narazie pojawiły się następujące wersje :
Delphi 1.0 , Delphi 1.02 , Delphi 2.0 , Delphi 3.0 , Delphi 4.0 , Delphi 4.0 SP1 , Delphi 5.0 - Desktop, Professional, Enterprise, Client/Server, Standard, Development, Delphi 6.0 Professional, Enterprise, Client/Server.

92. Jak w Delphi 4 używać polskich liter ?

Należy w rejestrze systemu w kluczu HKEY_CURRENT_USER\Software\Borland\Delphi\4.0\Editor\Options dodać nową wartość ciągu o nazwie NoCtrlAltKeys z wartością 1

Można do tego użyć programu Regedit lub zrobić to za pomocą Delphi

uses Registry;
procedure TForm1.FormCreate(Sender: TObject);
var Rejestr:TRegistry;
begin
Rejestr:=TRegistry.Create;
Rejestr.OpenKey('Software\Borland\Delphi\4.0\Editor\Options',True);
Rejestr.WriteString('NoCtrlAltKeys','1');
Rejestr.Free;
end;

93. Jak przekompilować teksty dbconsts.int (katalog ...DELPHI\DOC) aby podczas błędów na bazach danych pokazywany był komunikat w języku polskim ?

Z katalogu LIB skasuj plik dbconsts.dcu (lub zmień jego nazwę np. na dbconsts.dc_) . Następnie przekopiuj plik dbconsts.int z katalogu DOC do LIB i zamień nazwę na dbconsts.pas.

94. Jak rozpoznać wersję Delphi ?

begin
{$IFDEF VER80}
Form1.Caption:='Delphi 1';
{$ENDIF}
{$IFDEF VER90}
Form1.Caption:='Delphi 2';
{$ENDIF}
{$IFDEF VER100}
Form1.Caption:='Delphi 3';
{$ENDIF}
{$IFDEF VER120}
Form1.Caption:='Delphi 4';
{$ENDIF}
end;

95. Jak odtwarzać pliki *.wav i *.mid ?

const
FElementName='sciezka_i_nazwa_pliku_z_rozszerzeniem_wav_lub_mid';
var FFlags : Longint;
FError : Longint;
MCIOpened : Boolean;
FDeviceID : Word;
FFrames : Longint;

function Length: Longint;
var StatusParm: TMCI_Status_Parms;
begin
FFlags := mci_Wait or mci_Status_Item;
StatusParm.dwItem := mci_Status_Length;
FError := mciSendCommand( FDeviceID, mci_Status, FFlags,
Longint(@StatusParm));
Result := StatusParm.dwReturn;
end;

procedure Open;
var OpenParm: TMCI_Open_Parms;
begin
OpenParm.dwCallback := 0;
OpenParm.lpstrElementName := PChar(FElementName);
FFlags := mci_Open_Element;
OpenParm.dwCallback := Form1.Handle;
FError := mciSendCommand(0, mci_Open, FFlags, Longint(@OpenParm));
begin
MCIOpened := True;
FDeviceID := OpenParm.wDeviceID;
FFrames := Length div 10;
end;
end;

procedure Play;
var PlayParm: TMCI_Play_Parms;
begin
FFlags := mci_Notify;
PlayParm.dwCallback := Form1.Handle;
FError := mciSendCommand( FDeviceID, mci_Play, FFlags, Longint(@PlayParm));
end;

procedure Rewind;
var SeekParm : TMCI_Seek_Parms;
RFlags : Longint;
begin
RFlags := mci_Wait or mci_Seek_To_Start;
mciSendCommand( FDeviceID, mci_Seek, RFlags, Longint(@SeekParm));
end;

procedure Stop;
var GenParm: TMCI_Generic_Parms;
begin
FFlags:= mci_Notify;
GenParm.dwCallback := Form1.Handle;
FError := mciSendCommand( FDeviceID, mci_Stop, FFlags, Longint(@GenParm));
end;

procedure Close;
var GenParm: TMCI_Generic_Parms;
begin
FFlags := mci_Notify;
GenParm.dwCallback := Form1.Handle;
FError := mciSendCommand( FDeviceID, mci_Close, FFlags, Longint(@GenParm));
end;

Przed odtwarzaniem pliku należy użyć procedury Open.
Aby zacząć odsłuchiwanie trzeba użyć procedury Play.
Stop powoduje zatrzymanie odgrywanego fragmentu, ponowne użycie Start powoduje dalsze odtwarzanie pliku od miejsca w którym się zatrzymało.
Aby odtworzyć plik od początku należy użyć procedury Rewind a następnie Play.
Po zakończeniu odsłuchiwania pliku należy użyć procedury Close.

96. Jak odtwarzac animacje AVI na pelnym ekranie ?

Wielokrotnie przewija się problem jak zmusić MediaPlayer'a do odtwarzania animacji na pełnym ekranie tak jak czyni to Odtwarzacz Windows czy inne programy przechodzące w tryb pełnoekranowy - nie wykorzystując okna bez obramowania, pokazanego nad wszystkimi innymi, ponieważ takie rozwiązanie wiekszości osób nie satysfakcjonuje. Zatem ponizej przedstawiam przykład jak to sie robi

MediaPlayer1.FileName := 'c:\capture.avi';
{ najpierw otwieramy TMediaPlayer }
MediaPlayer1.Open;
{ przypisanie dla Display wartosci "nil" zmusza
TMediaPlayer do utworzenia wlasnego okna }
MediaPlayer1.Display := nil;
{ okno ma byc pelnoekranowe }
MediaPlayer1.DisplayRect := Rect(0,0, Screen.Width, Screen.Height);
{ i w koncu rozpoczynamy odtwarzanie }
MediaPlayer1.Play;

97. Jak używać w swojej aplikacji innych kursorów ?

Screen.Cursors[numer_kursora]:=LoadCursorFromFile('nazwa_pliku');
Form1.Cursor:=numer_kursora;

numer_kursora jest dowolną liczbą całkowitą większą od 0 lub mniejszą od -20.

98. Jak zamienić przyciski myszy ?

SwapMouseButton(True); Aby przywrócić przyciski myszy należy podać parametr False

99. Jak ustawić położenie kursora myszy na ekranie ?

SetCursorPos(0,0); // ustawia kursor w pozycji 0x0 czyli w prawym górnym rogu

100. Jak ograniczyć obszar po którym może poruszać się mysz ?

var Obszar:TRect;
begin
Obszar.Top:=0;
Obszar.Left:=0;
Obszar.Right:=20;
Obszar.Bottom:=20;
ClipCursor(@Obszar);
end;

101. Jak zawiesić działanie myszki ?

uses ShellApi;
ShellExecute(Handle,'open','rundll32','mouse,disable',nil,SW_SHOWNORMAL);

Aby przywrócić działanie myszki należy ponownie uruchomić system Windows

102. Jak pobrać lub ustawić prędkość dwukrotnego kliknięcia myszą ?

SetDoubleCliktime(10); Standardowo 500 osiągalne również poprzez parametr 0
Funkcja GetDoubleClickTime zwraca aktualne ustawienie

103. Jak schować i pokazać kursor myszy ?

ShowCursor(False);
ShowCursor(True);

104. Jak przesuwać komponenty za pomocą myszy ?

Przykład dla komponentu TButton. Trzeba obsłużyć dwa zdarzenia : OnMouseMove i OnMouseDown;

type
TForm1 = class(TForm)
public
poz,poz2:TPoint;
end;

procedure TForm1.Button1MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
begin
if ssLeft in Shift then begin
GetCursorPos(poz2);
Button1.Left:=Button1.left+(poz2.x-poz.x);
Button1.Top:=Button1.Top+(poz2.y-poz.y);
GetCursorPos(poz);
end;
end;

procedure TForm1.Button1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
GetCursorPos(poz);
end;

105. Jak odczytać kursor z pliku zasobów ?

Screen.Cursors[1]:=LoadCursor(hInstance,'NAZWAKURSORA');
Screen.Cursor:=1;

106. Jak odczytać położenie myszy na ekranie ?

procedure TForm1.Button1Click(Sender: TObject);
var Pozycja: TPoint;
begin
GetCursorPos(Pozycja);
Form1.Caption := IntToStr(Pozycja.X) + 'x' + IntToStr(Pozycja.Y);
end;

107. Operacje na oknach

ShowWindow(Handle,SW_HIDE); // ukrywanie aplikacji
ShowWindow(Handle,SW_SHOW); // pokazywanie ukrytej aplikacji
ShowWindow(Handle,SW_MAXIMIZE); // maksymilizacja okna
ShowWindow(Handle,SW_MINIMIZE); // minimalizacja okna

108. Jak zrobić listę otwartych okien w systemie ?

Na formie należy dodać komponent Memo oraz Button

function EnumChildProc(uchwyt:Hwnd;P:pointer):boolean;stdcall;
var winname,cname:array[0..144]of char;
begin
result:=true;
getwindowtext(uchwyt,winname,144);
getclassname(uchwyt,cname,144);
Form1.Memo1.Lines.Append('POTOMEK: TEXT:'+strpas(winname)+' KLASA:
'+strpas(cname)+' '+IntToStr(uchwyt));
end;

function EnumWindowProc(uchwyt:HWnd;P:Pointer):boolean;stdcall;
var winname,cname:array[0..144]of char;
begin
result:=true;
getwindowtext(uchwyt,winname,144);
getclassname(uchwyt,cname,144);
Form1.Memo1.Lines.Append('OKNO: TEXT:'+strpas(winname)+' KLASA:
'+strpas(cname)+' '+IntToStr(uchwyt));
enumchildwindows(uchwyt,@enumchildproc,0);
end;

procedure TForm1.Button1Click(Sender:TObject);
begin
EnumWindows(@enumwindowproc,0);
end;

109. Jak poustawiać okna obok siebie (tile) ?

var Obszar:TRect;
begin
Obszar.Top:=0;
Obszar.Left:=0;
Obszar.Right:=640;
Obszar.Bottom:=480;
TileWindows(GetDesktopWindow,MDITILE_HORIZONTAL,@Obszar,0,NIL);
end;

Drugim parametrem funkcji TileWindows może być MDITILE_VERTICAL

110. Jak poustawiać okna jedno pod drugim (cascade) ?

var Obszar:TRect;
begin
Obszar.Top:=0;
Obszar.Left:=0;
Obszar.Right:=640;
Obszar.Bottom:=480;
CascadeWindows(GetDesktopWindow,MDITILE_SKIPDISABLED,,@Obszar,0,NIL);
end;

111. Jak zmienić nazwę dowolnego okna (Caption) ?

SetWindowText(Handle,'Nowa nazwa');

112. Jak wyświetlić okno prowadzania danych tekstowych ?

Należy użyć funkcji InputBox:

Label1.Caption := InputBox('Okno z danymi','Wprowadź coś','');
// 1 Parametr: Caption okna
// 2 Parametr: Tekst zachęcający
// 3 Parametr: Domyślny łańcuch w polu edycyjnym

113. Jak zrobić systemowego About'a ?

I kolejny raz odwołujemy się do moduły ShelApi. Dodaj go do uses i na kliknięcie guzika w pisz taki oto kod:

ShellAbout(Form1.Handle, 'Program', 'Jest OK', Application.Icon.handle);
// 1 Parametr: Uchwyt okna
// 2 Parametr: Nazwa programu
// 3 Parametr: Tekst
// 4 Parametr: Uchwyt ikony naszej aplikacji

114. 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); // wsunięcie

115. Jak otworzyć i zamknąć napęd CDROM o dowolnej literze ?

Ponizsza procedura otwiera/zamyka szuflade napedu CD w oparciu o podane parametry, co pozwala na wybranie napedu jesli sa dwa lub wiecej w danym komputerze.

uses MMSystem;
procedure OpenCloseCD(Drive: String; OpenCD: Boolean);
var OpenParm: TMCI_Open_Parms;
begin
OpenParm.dwCallback := 0;
OpenParm.lpstrDeviceType := 'CDAudio';
OpenParm.lpstrElementName := PChar(Drive); {Drive musi byc w formacie "X:"}
if OpenCD then
begin {Otwieranie szuflady}
mciSendCommand(0, MCI_OPEN, MCI_OPEN_ELEMENT or MCI_OPEN_TYPE, Longin
(@OpenParm));
mciSendCommand(OpenParm.wDeviceID, MCI_SET, MCI_SET_DOOR_OPEN, 0);
end
else
begin {zamykanie szuflady}
mciSendCommand(0, MCI_OPEN, MCI_OPEN_ELEMENT or MCI_OPEN_TYPE, Longin
(@OpenParm));
mciSendCommand(OpenParm.wDeviceID, MCI_SET, MCI_SET_DOOR_CLOSED, 0);
end; {zamykanie MCI, bez tego kolejna próba otwarcia/zamkniecia szuflady zakonczyłaby się
niepowodzeniem!!! }
mciSendCommand(OpenParm.wDeviceID, MCI_CLOSE, MCI_NOTIFY, Longint(@OpenParm));
OpenCD := not OpenCD;
end;

116. Jak zamienić wartość Hex na Integer ?

function HexToInt(S : String) : Integer;

function HTI(C : Char) : Integer;
begin
if Ord(UpCase(c)) in [65..70] then result:=Ord(UpCase(C))-55 else
result:=StrToInt(C);
end;
var x:integer;
begin
result:=0;
for x:=0 to length(s)-1 do
result:=(result+HTI(s[length(s)-x])*round(intpower(16,x)));
end;

117. Jak odwołać się do konkretnego znaku w String'u ?

Nic prostrzego. Trzeba po prostu String'a potraktować jak tablicę Char'ów. Np.:

Form1.Caption := Jakis_String[4];

118. Jak zrobić systemowego About'a ?

I kolejny raz odwołujemy się do moduły ShelApi. Dodaj go do uses i na kliknięcie guzika w pisz taki oto kod:

ShellAbout(Form1.Handle, 'Program', 'Jest OK', Application.Icon.handle);
// 1 Parametr: Uchwyt okna
// 2 Parametr: Nazwa programu
// 3 Parametr: Tekst
// 4 Parametr: Uchwyt ikony naszej aplikacji

119. Jak zapisać String do obiektów pochodzących od TStream ?

Poniżej przedstawione jest kilka wariantów zapisywania zmiennej typu String do strumienia. Procedury są maksymalnie uproszczone, a ich mnogość wynika z faktu, że chciałem ukazać kilka wariantów radzenia sobie z tym zadaniem. Wszystkie procedury zapisują string do pliku w celu ukazania czy dana procedura rzeczywiście działa.

procedure SaveStringToFile_I(FileName, S: String);
var Plik: TFileStream;
begin
Plik := TFileStream.Create(FileName, fmCreate );
Plik.Write( Pointer(S)^, Length(S) );
Plik.Free;
end;

procedure SaveStringToFile_II(FileName, S: String);
var Plik: TMemoryStream; Str: TStringStream;
begin
Plik := TMemoryStream.Create;
Str := TStringStream.Create( S );
Plik.CopyFrom( Str, Length( S ) );
Plik.SaveToFile( FileName );
Plik.Free;
Str.Free;
end;

procedure SaveStringToFile_III(FileName, S: String);
var Plik: TMemoryStream;
begin
Plik := TMemoryStream.Create;
Plik.WriteBuffer( PChar( S )^, Length( S ) );
Plik.SaveToFile( FileName );
Plik.Free;
end;

procedure SaveStringToFile_IV(FileName, S: String);
var Plik: TMemoryStream; i: integer;
begin
Plik := TMemoryStream.Create;
Plik.SetSize( Plik.Size + Length(S) );
for i := 1 to Length(S) do
Plik.WriteBuffer( S[i], 1 );
Plik.SaveToFile( FileName );
Plik.Free;
end;

Uwaga techniczna: Przy korzystaniu ze strumieni należy zawsze pamiętać o odpowiednim pozycjonowaniu "kursora" w strumieniu. Wszystkie operacje typu read, write zmieniają aktualną pozycję, a zawsze zapisują/czytają od aktualnej pozycji, czyli jeśli coś nie działa sprawdź właściwość Position.

120. Jak dokonać konwersji krótkiej nazwy pliku na długą ?

Nie jest to może najkrótsze rozwiązanie tego problemu, ale na pewno działa.

function GetLongFileName(FileName: String): String;

var SearchRec : TSearchRec;
begin
if SysUtils.FindFirst(FileName, faAnyFile, SearchRec) = 0 then
begin
Result := SearchRec.FindData.CFileName;
Delete(FileName, LastDelimiter('\', FileName), 259);
while SysUtils.FindFirst(FileName, faAnyFile, SearchRec) = 0 do
begin
Result := StrPas(SearchRec.FindData.CFileName) + '\' + Result;
Delete(FileName, LastDelimiter('\', FileName), 1000);
end;
Result := FileName + '\' + Result;
end
else
begin
Result := '';
MessageBox(Handle, 'ERROREK', 'Plik nie istnieje!', 48);
end;
SysUtils.FindClose(SearchRec);
end;

Uwaga techniczna: nie wiem czy funkcja GetFullPathName jest do tego samego, ale moje proby jej wykorzystania doprowadzily do niczego, wiec trzeba bylo to rozwiazac inaczej.

121. Jak wykonać jakąś procedurę podczas pierwszego uruchaminia ?

procedure TMainForm.FormCreate(Sender: TObject);
var Reg : TRegistry; KeyExists : Boolean;
begin
Reg := TRegistry.Create;
try
KeyExists := Reg.OpenKey('Software\RegApp', False); // otworz klucz
if not KeyExists then
begin
//kod wykonywany przy pierwszym uruchomieniu
end;
finally
Reg.Free;
end;
end;

122. Jak skasować wartość z rejestru ?

uses Registry;

var Rejestr : TRegistry;
begin
Rejestr:=TRegistry.Create;
Rejestr.OpenKey('Nazwa klucza w którym jest wartość do skasowania jezeli
jest w innej gałęzi niż
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,478 unikalne wizyty