Hacking  
  Listopad 19 2017 16:53:32  
 
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: 4

. 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 150 ptytan.doc
1. JAK NAPISAC ODPOWIEDNIK UNIXOWYCH PS I KILL ?
2. JAK POBRAC LISTE WSZYSTKICH OKIEN W SYSTEMIE ?
3. JAK ODPALIC NOWY WATEK ?
4. JAK CZYTAC PAMIEC PROCESU ?
5. JAK RYSOWAC PO DOWOLNYM OKNIE ?
6. JAK UKRYC PROCES W SYSTEMIE ?
7. JAK RYSOWAC PO PULPICIE ?
8. JAK OTRZYMAC OBRAZ DOWOLNEGO OKNA ?
9. JAK OKRESLIC DOSTEPNE W SYSTEMIE FONTY ?
10. JAK SKONWERTOWAĆ OBRAZEK Z *.BMP NA *.JPG?
11. JAK UMIEŚCIĆ W COMBOBOX LISTĘ WSZYSTKICH ZAINSTALOWANYCH CZCIONEK?
12. JAK PISAC PROGRAMY SIECIOWE ? 13
13. JAK SKONSTRUOWAC WLASNY PAKIET IP [SOCKET_RAW] ?
14. JAK UZYSKAC INFORMACJE O SYSTEMIE ?
15. JAK ZAMKNĄĆ, ZRESETOWAĆ, WYLOGOWAĆ SIĘ Z SYSTEMU?
16. JAK ZMIENIĆ TAPETĘ PULPITU?
17. JAK WYSUNĄĆ SZUFLADKĘ CD-ROM-U.
18. JAK ZROBIĆ, ABY FORMA LUB KOMPONENT MIAŁY INNY KSZTAŁT?
19. JAK ZAŁADOWAĆ Z ZASOBÓW KURSOR?
20. JAK WSTAWIĆ DO RICHEDIT JAKIEŚ SYMBOLE?
21. JAK WYCINAĆ, WKLEJAĆ TEKST DO SCHOWKA?
22. JAK PRZECHWYCIĆ ADRES WWW WPISANY W PRZEGLĄDARCE?
36. JAK UKRYĆ PROGRAM Z PASKA ZADAŃ?
37. CO ZROBIĆ ABY UKRYĆ PRZYCISK APLIKACJI NA PASKU ZADAŃ?
38. JAK ZMIENIĆ POŁOŻENIE PRZYCISKU START?
39. JAK POBRAĆ IKONY PROGRAMÓW?
40. JAK ZABLOKOWAĆ PONOWNE URUCHOMIENIE PROGRAMU?
41. JAK OGRANICZYĆ POŁOŻENIE KURSORA MYSZKI?
42. JAK PRZENIEŚ SKASOWAĆ, ZMIENIĆ NAZWĘ KATALOGU?
43. JAK UTWORZYĆ SKRÓT DO PROGRAMU NA PULPICIE LUB W MENU START?
44. JAK WYDRUKOWAĆ STRONĘ TESTOWĄ DRUKARKI?
45. JAK NIE KORZYSTAJĄC Z KOMPONENTU DOKLEIĆ DO PLIKU PROGRAM EXE?
46. JAK PRZECHWYCIĆ URUCHAMIANIE WYGASZACZA EKRANU?
47. CO ZROBIĆ BY MENU "HELP" BYŁO PO PRAWEJ STRONIE, A RESZTA PO LEWEJ.
48. JAK ZROBIĆ TŁO GRADIENTOWE?
49. JAK PROGRAMOWO WŁĄCZYĆ I WYŁĄCZYĆ MONITOR?
50. W JAKI SPOSÓB ZAWIESIĆ DZIAŁANIE KLAWIATURY?
51. JAK UNIEMOŻLIWIĆ URUCHOMIENIE WYGASZACZA EKRANU?
52. GDZIE MOŻNA ZNALEŹĆ INFORMACJE I NAGŁÓWKI DO DIRECTX?
53. JAK DRUKOWAĆ TEKSTOWO W DELPHI?
54. JAK WYWOŁAĆ DOMYŚLNY PROGRAM POCZTOWY Z WPISANYM JUŻ ADRESEM ODBIORCY?
55. DLACZEGO PROGRAMY NAPISANE W DELPHI NIE "FRUNĄ" NA PASEK ZADAŃ A PO PROSTU SIĘ MINIMALIZUJĄ, JAK WINDOWS 3.11?
56. JAK DOSTOSOWAĆ WYDRUK DO RÓŻNYCH DRUKAREK?
57. DLACZEGO NIE DZIAŁA STRETCHDRAW DLA IKON?
58. DLACZEGO PROGRAM KORZYSTAJĄCY Z BAZ DANYCH PO PRZENIESIENIU NA INNY KOMPUTER NIE CHCE DZIAŁAĆ?
59. JAK REAGOWAĆ NA ZMIANĘ ROZDZIELCZOŚCI W TRAKCIE DZIAŁANIA PROGRAMU?
60. JAK DODAĆ WIZYTÓWKĘ PROGRAMU (ANG. SPLASH SCREEN)?
61. JAK DODAĆ WŁAŚCIWOŚCI DO FORMY ABY BYŁY WIDOCZNE W OKIENKU OBJECTINSPECTOR?
62. JAK POBRAĆ LISTĘ WŁAŚCIWOŚCI OBIEKTU W TRAKCIE WYKONYWANIA PROGRAMU?
63. JAK DODAĆ WŁASNĄ POZYCJĘ DO MENU WYWOŁYWANEGO SPOD EXPLORATORA PO KLIKNIĘCIU
64. JAK SPRAWDZIĆ CZY URUCHOMIONY PROGRAM JEST JUŻ W PAMIĘCI?
65. JAK WYŚWIETLIĆ STANDARDOWE OKNO WINDOWS SŁUŻĄCE DO WYBIERANIA KATALOGU?
66. CZY JEST MOŻLIWE SKOMPILOWANIE PROGRAMU NAPISANEGO W DELPHI 3.0 TAK ABY DZIAŁAŁ W WINDOWS 3.11?
67. GDZIE I ZA ILE MOŻNA KUPIĆ DELPHI, GDZIE MOŻNA ZNALEŹĆ INFORMACJĘ O TYM PRODUKCIE?
68. JAK ODCZYTAĆ NUMER SERYJNY DYSKU LUB DYSKIETKI?
69. NAPISAŁEM PROGRAM KORZYSTAJĄCY Z THTML I PO PRZENIESIENIU NA INNY KOMPUTER POJAWIA SIĘ BŁĄD "EXCEPTION EOLESYSERROR IN MODULE..." CO SIĘ DZIEJE?
70. JAK WYWOŁAĆ PROGRAM 32-BITOWY I POCZEKAĆ NA JEGO ZAKOŃCZENIE?
71. JAK DODAĆ SKRÓT DO DESKTOPU LUB MENU START W WINDOWS 95?
72. MAM PROBLEMY Z BAZAMI DANYCH W SIECI, NIE POJAWIAJĄ SIĘ ZMIANY W BAZACH.
73. JAK PRZESZUKIWAĆ DELPHI HELP I WIN32 HELP JEDNOCZEŚNIE?
74. PRZY PRÓBIE DODANIA NOWEGO REKORDU DO TABELI PARADOXA POJAWIA SIĘ BŁĄD "INDEX IS READ-ONLY". PRZY USTAWIANIU NAZWY INDEKSU WYSKAKUJE WYJĄTEK "INDEX IS OUT OF DATE".
75. JAK USUNĄĆ PRZYCISK PROGRAMU Z PASKA ZADAŃ?
76. JAK DODAĆ SWÓJ PROGRAM OBOK IKONKI ZEGARA W WINDOWS 95?
77. JAK ODEGRAĆ DŹWIĘK PRZECHOWYWANY W ZASOBACH?
78. JAK SCHOWAĆ LUB WYŁĄCZYĆ PRZYCISK START W WIN95?
79. CZY JEST COŚ DOKŁADNIEJSZEGO NIŻ TTIMER?
80. JAK UTWORZYĆ LUB ODTWORZYĆ INDEKSY DLA ISTNIEJĄCYCH TABEL?
81. MIMO ŻE USUWAM REKORDY Z BAZY TO JEJ ROZMIAR NIE ZMNIEJSZA SIĘ, CO ROBIĆ?
82. JAK ODCZYTAĆ LOKALNY ADRES IP?
83. JAK ZABLOKOWAĆ PRZEŁĄCZANIE ZADAŃ PRZY POMOCY ALT-TAB LUB CTRL-TAB?
84. JAK DODAĆ NAZWĘ DOKUMENTU DO LISTY OSTATNIO OTWARTYCH DOKUMENTÓW W MENU START?
85. JAK PROGRAMOWO WŁĄCZYĆ LUB WYŁĄCZYĆ MONITOR?
86. JAK ZMODYFIKOWAĆ MENU SYSTEMOWE FORMY?
87. JAK ODCZYTAĆ WIELKOŚĆ WOLNEGO OBSZARU NA EKRANIE BIORĄC POD UWAGĘ WYSOKOŚĆ (SZEROKOŚĆ) PASKA ZADAŃ?
88. JAK OTWORZYĆ BAZĘ ACCESS'A (*.MDB) POPRZEZ STEROWNIK MSACCESS?
89. JAK PROGRAMOWO ZMODYFIKOWAĆ USTAWIENIA BDE STEROWNIKA MSACCESS I INNYCH WARTOŚCI BDE?
90. NIE MOGĘ STWORZYĆ OKIENKA MDICHILD Z USTAWIONYM PARAMETREM PODESIGNED.
91. JAK SKOPIOWAĆ/SKASOWAĆ/PRZENIEŚĆ CAŁY KATALOG?
92. JAK PROGRAMOWO PODŁĄCZYĆ DYSK SIECIOWY?
93. NIE MOGĘ USTAWIĆ IKONY DLA OKNA MDI.
94. JAK ODCZYTAĆ OPIS BŁĘDU FUNKCJI API MAJĄC JEGO KOD?
95. JAK ZMIENIĆ FORMAT WYŚWIETLANIA I PRZECHOWYWANIA DAT DLA BAZY DANYCH?
96. JAK ZROBIĆ "INTELIGENTNE" OKNO Z ATRYBUTEM STAYONTOP?
97. JAK ZAMKNĄĆ INNĄ APLIKACJĘ?
98. JAK ZABLOKOWAĆ URUCHAMIANIE WYGASZACZA EKRANU WINDOWS?
99. JAK Z DELPHI 1.0 ODWOŁAĆ SIĘ DO 32-BITOWEJ BIBLIOTEKI DLL?
100. DLACZEGO DANE WYSŁANE POPRZEZ TCP/IP PRZYCHODZĄ W CZĘŚCIACH?
101. JAK PRZEKAZYWAĆ DANE MIĘDZY PROCESAMI?
102. W JAKI SPOSÓB MOGĘ ŚLEDZIĆ PRZESYŁANE W SYSTEMIE KOMUNIKATY?
103. JAK ZNALEŹĆ WSZYSTKIE PLIKI W KATALOGU I JEGO PODKATALOGACH?
104. JAK ZIDENTYFIKOWAĆ KOMPUTER KORZYSTAJĄC Z NUMERU MAC KARTY SIECIOWEJ?
105. JAK WYKRYĆ MOMENT WSTAWIENIA CZEGOŚ DO SCHOWKA?
106. JAK ZAMKNĄĆ SYSTEM?
107. JAK OBSŁUŻYĆ UPUSZCZANIE PLIKÓW NA FORMĘ? DRAG&DROP
108. JAK WYWOŁAĆ STANDARDOWE OKNO PODŁĄCZANIA DYSKU SIECIOWEGO?
109. JAK WYDOBYĆ SYSTEMOWĄ IKONĘ PLIKU?
110. NIE DZIAŁA TQUERY.REFRESH. CO ROBIĆ?
111. MAM PROBLEMY Z DRUKOWANIEM BITMAP. CO ROBIĆ?
112. JAK ZAPISAĆ POPRAWNIE DATĘ W SQL?
113. W JAKI SPOSÓB ZASYMULOWAĆ KLIKNIĘCIE MYSZY LUB KLAWIATURY, ALE W TAKI SPOSÓB, ŻEBY BYŁO WYKRYWALNE PRZEZ INNE PROGRAMY?
114. JAK SPAKOWAĆ BAZĘ DANYCH MS ACCESS?
115. JAK UZYSKAĆ POSORTOWANE DRZEWO KATALOGÓW?
116. JAK DODAĆ IKONĘ PROGRAMU DO TRAY'A. ( IKONKA OBOK ZEGARA WINDOWS ).
117. JAK SPRAWDZIĆ JAKI TYP DANYCH JEST W SCHOWKU?
118. 7. JAK ZROBIĆ, ABY W LISTBOX KAŻDA CZCIONKA BYŁA W OSOBNYM KROJU ( TAK JAK W WORDZIE 2000) ?
119. JAK POBRAĆ IKONĘ DOWOLNEGO PROGRAMU? 68
20. JAK RYSOWAĆ PO PULPICIE?
121. JAK ODCZYTAĆ NUMER KOLUMNY I WIERSZA W RICHEDIT?
122. JAK UZYSKAĆ SYSTEMOWE IKONKI?
123. NIE DZIAŁA "STAYONTOP". CO ROBIĆ?
124. JAK ZNALEŹĆ TEKST W RICHEDIT?
125. JAK USTAWIĆ WYGASZACZ EKRANU NA BRAK?
126. JAK WYŚWIETLIĆ IKONĘ SKOJARZONĄ Z DANYM ROZSZERZENIEM?
127. JAK WYŁĄCZYĆ SKRÓTY W WINDOWS? ( CTRL + DEL + ALT ).
128. JAK UKRYĆ LUB POKAZAĆ PASEK STANU?
129. JAK ZAREJESTROWAĆ SKRÓT KLAWIATUROWY DLA CAŁEGO SYSTEMU?
130. JAK NARYSOWAĆ TEKST W PIONIE?
131. JAK PRZEJŚĆ W STAN OCZEKIWANIA?
132. JAK USUNĄĆ MOJĄ APLIKACJĘ Z LISTY ZNAJDUJĄCEJ SIĘ PO NACIŚNIĘCIU KLAWISZY: CTRL + ALT + DEL?
133. JAK ODŚWIEŻYĆ WIDOK PULPITU?
134. JAK WYŚWIETLIĆ WINDOWSOWE BIAŁE OKNO INFORMACJĄ O BŁĘDZIE?
135. JAK SPRAWDZIĆ, CZY UŻYTKOWNIK JEST W INTERNECIE?
136. JAK WYKRYĆ POŁĄCZENIE Z NETEM?
137. JAK WYWOŁAĆ OKNO POŁĄCZENIA INTERNETOWEGO?
138. JAK UZYSKAĆ LISTĘ PLIKÓW ( EXE) URUCHOMIONYCH W SYSTEMIE?
139. JAK USUNĄĆ PLIK DO KOSZA?
140. JAK DODAĆ POZYCJĘ DO MENU JEŻELI KLIKNIE SIĘ NA IKONĘ APLIKACJI NA PASKU ZADAŃ?
141. JAK ZROBIĆ W RICHEDIT INDEKS DOLNY LUB GÓRNY? ( TAK JAK W WORDZIE ).
142. JAK WŁĄCZYĆ LUB WYŁĄCZYĆ DIODY KLAWISZY NUMLOCK, CAPSLOCK?
143. JAK ZAPISAĆ ZAWARTOŚĆ SCHOWKA DO PLIKU, I ZAWARTOŚĆ PLIKU DO SCHOWKA?
144. JAK ZAŁADOWAĆ OBRAZEK ZE SCHOWKA DO KOMPONENTU IMAGE?
145. JAK URUCHOMIĆ WYGASZACZ EKRANU?
146. W JAKI SPOSÓB POKAZAĆ OKNO KOPIOWANIA Z DYSKIETKI NA DYSKIETKĘ?
147. CO ZROBIĆ, GDY NIE CHCĘ ABY NA PASKU ZADAŃ WYŚWIETLONA BYŁA "BELKA" FORMY WYWOŁANEJ Z DLL'A?
148. JAK ZAŁOŻYĆ GLOBALNEGO HOOKA NA KLAWIATURĘ?
149. JAK POBRAĆ CZĘSTOTLIWOŚĆ TAKTOWANIA PROCESORA?
150. RREJESTROWANIE TYPU PLIKU
151. WWEWALENIA CZEGO? DO SYSTRAYA



1. Jak napisac odpowiednik unixowych PS i KILL ?
proponuje na poczatek przyjrzec sie unitowi: TLHelp32. Juz ? Ok.

{BEGIN OF PS.PAS}
unit PS;

interface
uses
windows,sysutils,tlhelp32,classes;

function MyPS:TStringList;
function MyKILL(pid:integer):boolean;

implementation

{A oto PS}
function MyPS:TStringList;
var
sHandle:thandle;pEntry:tprocessentry32;
begin
sHandle:=createtoolhelp32snapshot(TH32CS_SNAPPROCESS,0);
pEntry.dwSize:=sizeof(pEntry);
Result:=TStringList.create;
if integer(process32first(sHandle,pEntry))<>0 then
repeat
Result.Append(inttostr(pEntry.th32ProcessID)+': '+pEntry.szExeFile);
until integer(process32next(sHandle,pEntry))=0;
closehandle(sHandle);
end;
{Koniec PS'a}

{A oto KILL}
function MyKILL(pid:integer):boolean;
var
sHandle:thandle;
begin
try
sHandle:=openprocess(PROCESS_TERMINATE,bool(0),pid);
if integer(terminateprocess(sHandle,0))=0 then result:=false else result:=true;
except end;
end;
{Koniec KILL'a}


end.
{END OF PS.PAS}

2. Jak pobrac liste wszystkich okien w systemie ?

Oto przykladowe procedury, ktore wykonuja iteracje po wszystkich oknach w
systemie okreslajac ich klase (class) oraz text. Dane zostana wpisane do
struktury List:TStringList ktora musi najpierw zostac zainiciowana.


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

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


aby rozpoczac iteracje wykonujemy:

enumwindows(@enumwindowproc,0);

lista okien, Windows, pulpit, pasek zadań
Oto przykładowy kod wykorzystujący funkcje WinAPI:
function EnumWindowsProc(WHandle: HWND; LParM: LParam): Boolean;StdCall;Export;
var Title,ClassName:array[0..128] of char;
sTitle,sClass,Linia:STRING ;
begin
Result:=True;
GetWindowText(wHandle, Title,128);
GetClassName(wHandle, ClassName,128);
sTitle:=Title;

sClass:=ClassName;
if IsWindowVisible(wHandle) then
begin
Linia:=sTitle+' '+sClass+' '+IntToHex(wHandle,4);
Form1.Listbox1.Items.Add(Linia);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
EnumWindows(@EnumWindowsProc,0);
end;
Na formie powinien być komponent typu TListBox. Zostanie on wypełniony listą
aktywnych okien.
Źródło informacji: Sławomir Świder



3. Jak odpalic nowy watek ?
Najprosciej mozna to zrobic w ten sposob:


procedure WkurzajUsera;
begin
repeat beep;sleep(1000);until false;
end;

//i podczepiamy nasza procedurke jako watek

CreateThread(nil,0,@WkurzajUsera,nil,0,x);

(x:integer)

win32.hlp:
HANDLE CreateThread(

LPSECURITY_ATTRIBUTES lpThreadAttributes, // address of thread security attributes
DWORD dwStackSize, // initial thread stack size, in bytes
LPTHREAD_START_ROUTINE lpStartAddress, // address of thread function
LPVOID lpParameter, // argument for new thread
DWORD dwCreationFlags, // creation flags
LPDWORD lpThreadId // address of returned thread identifier
);


4. Jak czytac pamiec procesu ?
Aby moc przeczytac pamiec procesu nalezy miec jego uchwyt, pozniej ustawic
go w tryb do odczytu i podac miejsce gdzie maja trafic dane przeczytane z
pamieci.


function ReadProcMem(var path,buf:PChar;length:integer):integer;
var ProcInf:TProcessInformation; //tutaj otrzymamy identyfikatory procesu i watku glownego
StartInf:TStartupInfo; //tutaj nieistotne
begin
fillchar(StartInf,sizeof(StartInf),0); //ta struktuta nie bedzie uzywana
fillchar(Buf,length,0); //czyscimy bufor
Result:=0;
CreateProcess(path,nil,nil,nil,false,0,nil,nil,StartInf,ProcInf); //tworzymy nowy proces
OpenProcess(PROCESS_VM_READ,false,ProcInf.dwProcessId); //otwieramy go z flaga do odczytu
ReadProcessMemory(ProcInf.hProcess,nil,Buf,length,result); //czytamy length bajtow z pamieci
TerminateProcess(ProcInf.hProcess,0); //wykanczmy proces z flaga wyjscia 0
end;


5. Jak rysowac po dowolnym oknie ?
Musimy znac jego uchwyt.


Canvas.HAndle:=GetWindowDC(znane_okno.handle);
{tutaj mozmy rysowac na Canvas}
ReleaseDC(znane_okno.handle,canvas.handle);//pozniej musimy jeszcze zwolnic uchwyt

6. Jak ukryc proces w systemie ?
Mozna to zrobic na pare sposobow. Pierwszy jest bardzo prosty - nazwac
plik .exe (bez nazwy), drugi rownierz - wpisujemy w application.title:=''
ale co jesli program nie ma interfejsu application (np. konsolowy) -
istnieje bardzo ciekawa funkcja systemowej biblioteki kernel32.dll


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

no i teraz tylko:

registerserviceprocess(0,1);

raczej sie nie pokaze po ctrl+alt+del

36. Jak ukryć program z paska zadań?
Pasek musi być ukryty zanim stworzone zostaną formy. Poniższy
kod należy więc dodać do źródła projektu ( Project | View Source
). Tak powinna wyglądać całość:
program Project1;

uses
Forms,
Windows,
Unit1 in 'Unit1.pas' {Form1};

{$R *.RES}

var
Ex : Integer;

begin
Application.Initialize;

Ex:=GetWindowLong(Application.Handle, GWL_EXSTYLE);
SetWindowLong(Application.Handle,GWL_EXSTYLE,
Ex or WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW);

Application.CreateForm(TForm1, Form1);
Application.Run;
end.
Program jest ukrywany z paska zadań dzięki parametrowi
WS_EX_TOOL_WINDOW.


37. Co zrobić aby ukryć przycisk aplikacji na pasku zadań?
Wpisać procedurę:
ShowWindow(Application.Handle, SW_HIDE); ///ukrywanie
ShowWindow(Application.Handle, SW_RESTORE); ///przywracanie

38. Jak zmienić położenie przycisku Start?
var
Uchwyt: THandle;

begin

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

end;


RYSOWANIE, GRAFIKA

7. Jak rysowac po pulpicie ?

Pulpit mozna traktowac jak zwykly Canvas.
GetDesktopWindow - zwraca uchwyt pulpitu.
Canvas.Handle:=GetWindowDC(GetDesktopWindow {w Win95 moze byc poprostu
0}); dalej tak jak wyzej.


8. Jak otrzymac obraz dowolnego okna ?
Oczywiscie ta procedura dziala tylko dla obiektow pochodnych od
TWinControl (handle)


function Control2Bitmap(Obj:TWinControl):TBitmap;
begin
Result:=Tbitmap.create;
Result.Height:=Obj.Height;
Result.Width:=Obj.Width;
Result.Canvas.Handle:=CreateDC(nil,nil,nil,nil);
Result.canvas.lock;
Obj.PaintTo(Result.Canvas.Handle,0,0);
result.canvas.unlock;
DeleteDC(result.canvas.handle);
end;


teraz mozemy sobie zapisac to do pliku czy zrobic cokolwiek innego co
umozliwia TBitmap;


9. Jak okreslic dostepne w systemie fonty ?
Zrobi to za nas funkcja EnumFonts, ktora do iteracji po wszystkich fontach
danego urzadzenia uzywa funkcji zwrotnej


funkcja zwrotna ma postac:

function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
FontType: Integer; Data: Pointer): Integer; stdcall;
begin
Form1.memo1.lines.append(LogFont.lfFaceName); //tutaj np. dodajemy nazwy fontow do listy
Result := 1; // jesli chcemy przerwac iteracje musimy jako result podac 0
end;

procedure TForm1.Button1Click(Sender: TObject);
var DC:HDC;
begin
DC:=GetDC(0); //device context pulpitu, jesli chcemy fonty drukarki podaemy printer.handle
enumfonts(DC,nil,@EnumFontsProc,nil); //podajemy adres naszej funkcji
end;


10. Jak skonwertować obrazek z *.bmp na *.jpg?
Począwszy od Delphi 3 znajduje się moduł jpeg. To właśnie dzięki
niemu można dokonać konwersji. Wystarczy, że zrobisz coś
takiego:
var
Bitmap : TBitmap;
JPG : TJPEGImage;

begin
try
Bitmap := TBitmap.Create;
Bitmap.LoadFromFile('C:\plik.bmp');
JPG := TJPEGImage.Create;
JPG.Assign(B);
JPG.SaveToFile('C:\plik.jpg');
finally
B.Free;
JPG.Free;
end;
end;


11. Jak umieścić w ComboBox listę wszystkich zainstalowanych czcionek?
Wystarczy tylko jedna linia kodu:
ComboBox1.Items := Screen.Fonts;


INTERNET, SIEć


12. Jak pisac programy sieciowe ?
Po szczegoly odsylam do komponentow na DSP [query:socket] i do literatury,
tutaj przyblize kilka funkcji pozwalajacych w najprostszy sposob wysylac i
odbierac dane.

Najpierw musimy dysponowac gniazdkiem (socketem) przez ktore bedziemy
mogli sie komunikowac, kazde gniazdko okreslone jest 6 wspolczynnikami :
port lokalny, port docelowy, adres lokalny, adres docelowy, protokol (tcp
lub udp, my zajmiemy sie tcp), aktywne / pasywne.

gniazdko w systemie widziane jest jako zwykla liczba typu integer, jest to
w zasadzie uchwyt okna istnieja 2 podstawowe funkcje ktore go zwracaja:
socket i accept.

funkcja socket tworzy nowe gniazkdo, jej przykladowe uzycie:

SSOCK:=socket(AF_INET,SOCK_STREAM,IPPROTO_TCP);

uzycie accept jest troche bardziej zlozone, najpierw musimy miec zwykle
gniazdko utworzone przez socket, nastepnie przypisujemy temu gniazdku port
lokalny i ustawiamy je w tryb sluchania funkcja listen, funkcja accept
uzywa 'sluchajacego' gniazdka do utworzenia calkowicie nowego polaczenia z
komputerem ktory laczy sie z nami (my jestesmy serverem a on klientem).


SSOCK,CSOCK:integer;

procedure make_listen_socket;
var
addr,taddr:tsockaddrin;
sock,size:integer;
begin
fillchar(addr,sizeof(addr),0);
fillchar(taddr,sizeof(taddr),0);
fillchar(maddr,sizeof(maddr),0);

SOCK:=socket(AF_INET,SOCK_STREAM,IPPROTO_TCP); // jesli socket=-1 to blad!

addr.sin_family:=AF_INET;
addr.sin_addr.s_addr:=htonl(INADDR_ANY);
addr.sin_port:=htons(666); //przypisujemy gniazdku port lokalny
bind(SOCK,addr,sizeof(addr)); //jesli bind<>0 to blad !
listen(SOCK,5); //jesli listen<>0 to blad !

repeat
sleep(1000);
size:=sizeof(taddr);
CSOCK:=accept(SOCK,@taddr,@size);
until csock>0; //az ktos sie z nami polaczy
end;

function connect_to_destination(DESTINATION_HOST:string;DESTINATION_PORT:integer):integer;
var
addr:tsockaddrin;
he:phostent;
mode:integer;
begin

SSOCK:=socket(AF_INET,SOCK_STREAM,IPPROTO_TCP);
fillchar(addr,sizeof(addr),0);

addr.sin_family:=AF_INET;
addr.sin_addr.s_addr:=inet_addr(@DESTINATION_HOST[1]); //moze byc pchar(DESTINATION_HOST)
addr.sin_port:=htons(DESTINATION_PORT);

he:=gethostbyname(@DESTINATION_HOST[1]); //wywolujemy resolver
if he<>nil then move(he^.h_addr_list^^, addr.sin_addr.s_addr, he^.h_length)

result:=connect(SSOCK,addr,sizeof(addr));
end;


//ta funkcja wysle nam cos przez gniazdko
function say(gniazdko:integer;co:string):integer;
begin
result:=send(gniazdko,co[1],length(co),0);
end;

//ta funkcja odbierze nam cos przez gniazdko do bufora 'gdzie' ('ile' bajtow)
function hear(gniazdko:integer;var gdzie:string;ile:integer):integer;
begin
result:=recv(gniazdko,gdzie[1],ile,0);
end;



13. Jak skonstruowac wlasny pakiet IP [SOCKET_RAW] ?
Niestety nie da sie tego poki co zrobic za pomoca funkcji winsocka, tzn.
nie jest udostepniony ten tryb. Co prawda w winsocku 2.x+ teoretycznie
mozna tworzyc SOXKET_RAW ale nie da sie skonstruowac wlasnego pakietu, tak
wiec poki co zabawe w spoofing i inne unixowe dobrodziejstwa trzeba
odlozyc.

btw. jak ktos jest zainteresowany napisaniem odpowiedniego vxd do obslugi
czegos takiego to niech napisze na priva.

INNE ZAAWANSOWANE


14. Jak uzyskac informacje o systemie ?
Istnieje cala grupa funckji WinAPI ktora to umozliwia, tutaj przytocze
krotki opis.

InitiateSystemShutdown - rozpoczyna zamykanie systemu
AbortSystemShutdown - anuluje zamykanie systemu
ExpandEnvironmentStrings - pobiera zmienne srodowiskowe
GetComputerName - nazwa komputera
GetKeyboardType - typ klawiatury
GetSysColor - podaje kolor dla wybranego elementu systemu
GetSystemDirectory - katalog systemowy
GetSystemInfo - zwraca strukture zawierajaca informacje o architekturze
systemu (typ procesora)
GetSystemMetrics - masa informacji na temat systemu, np. jak zostal
uruchomiony itp.
GetThreadDesktop - zwraca uchwyt pulpitu przypisanego do podanego watku
GetUserName - zwraca nazwe uzytkownika
GetVersion - czy Windows NT czy 95
GetVersionEx - rozszerzona informacja o versji systemu
GetWindowsDirectory - katalog WINDOWS
SetComputerName - ustawia nazwe komputera jaka bedzie obowiazywac po
restarcie
SetSysColors - ustawia kolor podanych elementow systemu
SystemParametersInfo - pobiera lub ustawia rozne informacje systemowe.


15. Jak zamknąć, zresetować, wylogować się z systemu?
Win32Check(ExitWindows(0, 0));
// Zaloguj się jako nowy użytkownik

Win32Check(ExitWindowsEx(EWX_REBOOT, 0));
//Uruchom ponownie komputer

Win32Check(ExitWindowsEx(EWX_SHUTDOWN, 0));
// Wyłącz komputer


16. Jak zmienić tapetę pulpitu?
var
S : String;
begin
S := 'zdjecie.bmp';
SystemParametersInfo(SPI_SETDESKWALLPAPER,0, PChar(s),
SPIF_UPDATEINIFILE or SPIF_SENDWININICHANGE);

17. Jak wysunąć szufladkę CD-ROM-u.
Należy skorzystać z modułu MMSystem. Oto kod:
mciSendString('Set cdaudio door open wait',nil,0,handle);
//wysuń
mciSendString('Set cdaudio door closed wait',nil,0,handle);
//wsuń

18. Jak zrobić, aby forma lub komponent miały inny kształt?
Poniższa linia robi z formy elipsę. Jeżeli chcesz zmienić
kształt innego komponentu to zamiast Handle podajesz np.
Button1.Handle
SetWindowRgn(Handle,CreateEllipticRgn(0, 0, Width, Height),
True);



19. Jak załadować z zasobów kursor?
Gdy już masz przygotowany kursor w edytorze zasobów robisz np.
coś takiego:
{$R NAZWAZASOBU.RES}
const
crMojKursor = 1; //Numer musi być większy od zera.
begin
Screen.Cursors[crMojKursor] :=
LoadCursor(hInstance,'MOJKURSOR');
Form1.Cursor := crMojKursor;
Następuje tutaj załadowanie kursora z zasobów. Na samym początku
deklarowana jest nazwa zasobu, a później stała z nazwą kursora.
Więcej o zasobach możesz poczytać sobie w dziale Delphi.


39. Jak pobrać ikony programów?
Należy skorzystać z modułu SHELLAPI oraz funkcji ExtractIcon
uses ShellApi;

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

RICHEDIT, SCHOWEK

20. Jak wstawić do RichEdit jakieś symbole?
Najpierw musisz znać numer ASCII takiego znaku. W tym celu użyj
mojego programu do podawania kodów ASCII. Jest to program z
kodem źródłowym i żeby go używać musisz go skompilować. Żeby to
zrobić potrzebujesz Delphi 5. Jeżeli nie masz takiej wersji
Delphi - napisz do mnie, a ja prześle Ci wersje skompilowaną.
Gdy już znasz kod takiego symbolu do RichEdit wpisz:
RichEdit.SelText := #169 // np. taki numer....


21. Jak wycinać, wklejać tekst do schowka?
Możesz użyć funkcji:
Memo1.CopyToClipBoard; // Kopiowanie...
Memo1.CutToClipboard; // Wycinanie...
Memo1.PasteFromClipboard; // Wklejanie...




40. Jak zablokować ponowne uruchomienie programu?
var
hM : HDC;
begin
hM:=CreateFileMapping(THANDLE($FFFFFFFF),nil,
PAGE_READONLY,0,32,'ApplicationTestMap');

if GetLastError=ERROR_ALREADY_EXISTS then
begin
ShowMessage('Nie można uruchomić tego samego programu');
Application.Terminate;
CloseHandle(hM);
end;
Z tym, że ciąg "ApplicationTestMap" musi być unikalny dla całego
systemu - dwie aplikacje nie mogę wykorzystać tego samego
parametru.



41. Jak ograniczyć położenie kursora myszki?
Służy do tego funkcja ClipCursor. A całość może wyglądać np.
tak:
var
R : TRect;
begin
with R do
begin
Top := 20;
Bottom := 20;
Left := 20;
Right := 20;
end;
ClipCursor(@R);
end;



42. Jak przenieś skasować, zmienić nazwę katalogu?
Najlepiej jest skorzystać z modułu SHELLAPI. Oto przykład:
uses ShellAPI;

procedure TForm1.Button1Click(Sender: TObject);
var R : TSHFileOpStructA;
begin
with R do
begin
Wnd:=Handle; // oznaczenie uchwytu
wFunc:=FO_COPY;// opcja
pFrom:='c:\moj'; // z katalogu
pTo:='c:\dokumenty\moj';// do katalogu...
fFlags:=FOF_NOCONFIRMMKDIR;
end;
if SHFileOperation(R)<>0 then
ShowMessage('Błąd podczas kopiowania')
end;
Zamiast parametru FO_COPY możesz użyć:
FO_DELETE - kasuje wFrom
FO_RENAME - zmienia nazwę z wFrom do w wTo
FO_MOVE - przenosi z wFrom do wTo
Można to wykorzystać do operacjami okienek Windowsa oraz z
ProgressBar. Więcej informacji w pomocy Delphi lub w dziale
Delphi.




43. Jak utworzyć skrót do programu na pulpicie lub w menu start?
To nie zadziała w wypadku Delphi 2. W tym wypadku tworzony jest
skrót do programu Notepad.

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:='C:\Windows\NOTEPAD.EXE';
with MySLink do
begin
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+'\Notatnik.lnk';
MyPFile.Save(PWChar(WFileName),False);
MyReg.Free;
end;





44. Jak wydrukować stronę testową drukarki?
Należy odwołać się do biblioteki rundll.dll i skorzystać z
modułu ShellAPI.
uses ShellAPI;
ShellExecute(Handle, 'open',
'rundll32','msprint2.dll, RUNDLL_PrintTestPage',nil,
SW_SHOWNORMAL);


45. Jak nie korzystając z komponentu dokleić do pliku program EXE?
Jest to średnio trudne. Postępuj według poniższych wskazówek:
Naszym celem będzie dodanie do zasobów Windows. Ponieważ
standardowy edytor zasobów nie umożliwia tego musimy to zrobić
ręcznie. Do jednego katalogu skopiuj Twój plik EXE oraz program
"brcc32.exe", który jest częściom Delphi [ znajduje się w
katalogu ...\Delphi\Bin ].
Teraz stwórz plik z rozszerzeniem *.rc, a następnie uruchom go w
Notatniku. Wpisz taki tekst:
PROGRAM RCDATA "Program.exe"
Program.exe to oczywiście nazwa Twojego programu, który chcesz
włączyć do EXEca. Ok, teraz zapisz ten plik.
Musisz użyć programu brcc32.exe, aby skompilować zasób. W tym
celu uruchom okienko MS - DOS'a i przejdź do katalogu w którym
skopiowałeś program brcc32.exe. W MS - DOS'ie do katalogu
przechodzi się poleceniem:
cd NazwaKatalogu
a przejście do katalogu wyżej powoduje polecenie:
cd..
Gdy już jesteś w tym katalogu wpisz:
brcc32.exe PlikRC.rc
"PlikRC.rc" to plik, który przed chwilą edytowałeś. Jeżeli
wszystko pójdzie dobrze w katalogu powinieneś ujrzeć plik z
rozszerzeniem *.res, który zawiera Twój program! Moje gratulacje
- właśnie dołączyłeś program do zasobów.
Teraz w programie należy w którymś miejscu dopisać linię:
{$R PLIKRC.RES}
Teraz w którejś procedurze wpisz:
var
Res : TResourceStream;
begin
Res:=TResourceStream.Create(hInstance,'PROGRAM',RT_RCDATA);
Res.SaveToFile('Program.exe'); // zapisz na dysk
Res.Free;
end;
Jeżeli postępowałeś wg. powyższych wskazówek powinno się udać.
Po kompilacji w jednym EXEcu powinien znaleźć się Twój doklejony
program.




46. Jak przechwycić uruchamianie wygaszacza ekranu?
W sekcji "private" umieść taką linię kodu:
procedure WMSYSCommand(var M: TMessage); message WM_SYSCOMMAND;

W sekcji "Implementation" natomiast:
procedure TForm1.WMSYSCommand(var M: TMessage);
begin
if M.WParam <> SC_SCREENSAVE then inherited
else ShowMessage('Uruchamianie wygaszacza...');

M.Result := 0;
end;



47. Co zrobić by menu "Help" było po prawej stronie, a reszta po lewej.
Zakładając, że "MainMenu" to komponent "TMainMenu", a "Pomoc1"
to menu z pomocą można zrobić tak w procedurze "OnCreate" formy:
procedure TForm1.FormCreate(Sender: TObject);
var
Info: TMenuItemInfo;
Buff: array[0..MAX_PATH] of Char;
begin
Info.cbSize := SizeOf(TMenuItemInfo);
Info.fMask := MIIM_TYPE;
Info.dwTypeData := Buff;
Info.cch := SizeOf(Buff);
GetMenuItemInfo(MainMenu1.Handle, Pomoc1.Command, False, Info);
Info.fType := Info.fType or MFT_RIGHTJUSTIFY;
SetMenuItemInfo(MainMenu1.Handle, Pomoc1.Command, False, Info);
end;

48. Jak zrobić tło gradientowe?
Na formie tworzymy Image1. AutoSize formy ustawiamy na True.
implementation
var
y :integer;


procedure TForm1.FormCreate(Sender: TObject);

begin
y:=0;
image1.canvas.pen.color :=clblue; //kolor z jakiego będzie schodzić
with image1.canvas do begin
while y lineto (image1.Width, y);
y:= y+1;
moveto (0, y);
lineto (image1.Width, y); //rysuje linię o długości równej długości formy
y:= y+1;
moveto (0, y);
pen.color :=pen.color+1; //ta wartość może być różna, od niej zależy o
ile kolorów będzie się różnić następna linia
end;
end;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
image1.Height :=form1.Height;
image1.Width :=form1.Width;
with image1.canvas do begin
while y lineto (image1.Width, y);
y:= y+1;
moveto (0, y);
lineto (image1.Width, y);
y:= y+1;
moveto (0, y);
pen.color :=pen.color+1;
end;
end;
end;


49. Jak programowo włączyć i wyłączyć monitor?
SendMessage(Application.Handle,wm_SysCommand,SC_MonitorPower,0);
//wyłączenie monitora
SendMessage(Application.Handle,wm_SysCommand,SC_MonitorPower,-1);
//włączenie monitora


50. W jaki sposób zawiesić działanie klawiatury?
Do uses należy dodać ShellApi a następnie:
ShellExecute(Handle,'open','rundll32','keyboard,disable',nil,SW_SHOWNORMAL);
Niestety wpisanie enable zamiast disable, nic nie zmieni, jedynym sposobem
na przywrócenie działania klawiatury jest ponowne uruchomienie systemu
Windows.

51. Jak uniemożliwić uruchomienie wygaszacza ekranu?
SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, Word(False), nil, 0);
//włączenie blokady
SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, Word(True), nil, 0);
//wyłączenie blokady



52. Gdzie można znaleźć informacje i nagłówki do DirectX?
DirectX, Blake Stone, DelphiX, DelphiJedi
Informacje o DirectX oraz pliki nagłówkowe w formacie *.H (do języka C) można
znaleźć na stronach firmy Microsoft dotyczących Microsoft Software Development
Network. Jeśli jesteś tam po raz pierwszy to będziesz musiał się zarejestrować
(jest to bezpłatne). Czasem można znaleźć DirectX SDK (Software Development Kit)
na płytach CD dołączanych do czasopism komputerowych. Przetłumaczone pliki
nagłówkowe znajdują się na stronach Blake'a Stone chociaż trudno jest się tam
dostać. Mirror nagłówków prowadzi również Radosław Przybył. Na DSP znajduje się
również biblioteka DelphiX znacznie ułatwiająca pisanie programów pod DirectX.
Warto też zajrzeć na strony projektu JEDI.

53. Jak drukować tekstowo w Delphi?
drukowanie, tekst
Należy korzystać z funkcji WinAPI operujących na drukarkach:
uses WinSpool,Printers;

procedure TForm1.Button1Click(Sender: TObject);
var Size,n:Integer;
H:THandle;
Info:PAddJobInfo1;
F:TextFile;
sPrinterName,sDriver,sPort:array[0..255]of Char; // sDriver i sPort nie będą
// wykorzystane
begin
Printer.GetPrinter(sPrinterName,sDriver,sPort,h);

OpenPrinter(sPrinterName,H,nil);
try
AddJob(H,1,nil,0,Size); // pobranie rozmiaru bufora

GetMem(Info,Size);

try
// Poniższa funkcja zwraca nam nazwę pliku do którego możemy zapisywać
AddJob(H,1,Info,Size,n);

// Tutaj zapisujemy do pliku
AssignFile(F,Info^.Path);Rewrite(F);
try
Writeln(F,'Hello world!');
Writeln(F,'To jest test drukowania tekstowego...');
finally
CloseFile(F);
end;

// Wrzucamy plik do kolejki drukowania, potem Windows go skasuje
ScheduleJob(H,Info^.JobId);
finally
// Zwalniamy pamięć...
FreeMem(Info,Size);
end;
finally
// ...i drukarkę
ClosePrinter(H);
end;
end;
Można też spróbować innego sposobu. Użyć CreateFile aby otrzymać uchwyt do LPT1:
LPTHandle:=CreateFile('LPT1',GENERIC_WRITE,0,PSecurityAttributes(nil),
OPEN_EXISTING, FILE_FLAG_OVERLAPPED,0);
Następnie użyć WriteFile aby wysłać kolejne znaki lub:
while not TransmitCommChar(LPTHandle,CharToSend) do Application.ProcessMessages;
Powyższy kod wysyła kolejne znaki na port równoległy za każdym razem czekając na
obsłużenie znaku przez drukarkę.
Bogdan Polak zwrócił mi uwagę, że w nowszych wersjach Delphi deklaracja nagłówka
funkcji AddJob w pliku winspool.pas wygląda tak:
function AddJob ( hPrinter: THandle; Level: DWORD; pData: Pointer; cbBuf: DWORD;
var pcbNeeded: DWORD ): BOOL; stdcall;
parametr pcbNeeded jest typu DWORD, a w powyższym przykładzie użyto zmiennych
Integer.
Krzysztof Świątkowski zwrócił uwagę na wadę powyższego rozwiązania. Nie zawsze
działa ono poprawnie dla drukarek sieciowych. Oto jego propozycja:

function DirectPrint( const PrinterName : string;Data : PByte;
DataLen : Cardinal; out Error : string) : Boolean;
var
hPrinter : THandle;
DocInfo : TDocInfo1;
Job, DataWritten : Cardinal;
begin
Error := 'Unknown Error';
Result := False;
if not OpenPrinter(PChar(PrinterName), hPrinter, nil) then begin
Error := SysErrorMessage(GetLastError);
Exit;
end;
DocInfo.pDocName := 'My Document name';
DocInfo.pOutputFile := nil;
DocInfo.pDatatype := 'RAW';

Job := StartDocPrinter(hPrinter, 1, @DocInfo);
if Job=0 then begin
Error := SysErrorMessage(GetLastError);
ClosePrinter(hPrinter);
Exit;
end;

if not StartPagePrinter( hPrinter ) then begin
Error := SysErrorMessage(GetLastError);
EndDocPrinter(hPrinter);
ClosePrinter(hPrinter);
Exit;
end;

if not WritePrinter(hPrinter, Data, DataLen, DataWritten) then begin
Error := SysErrorMessage(GetLastError);
EndPagePrinter(hPrinter);
EndDocPrinter(hPrinter);
ClosePrinter(hPrinter);
Exit;
end;

if not EndPagePrinter(hPrinter) then begin
Error := SysErrorMessage(GetLastError);
EndDocPrinter(hPrinter);
ClosePrinter(hPrinter);
Exit;
end;

if not EndDocPrinter(hPrinter) then begin
Error := SysErrorMessage(GetLastError);
EndDocPrinter(hPrinter);
ClosePrinter(hPrinter);
Exit;
end;

ClosePrinter(hPrinter);

Result := DataWritten=DataLen;
end;

procedure PrintString(s : string);
var

h : Cardinal;
sPrinterName,sDriver,sPort:array[0..255]of Char; // sDriver i sPort nie będą
// wykorzystane
Err : string;
begin
Printer.GetPrinter(sPrinterName,sDriver,sPort,h);

if not DirectPrint(sPrinterName,PByte(PChar(s)),length(s),Err) then
ShowMessage(Err);
end;


Źródło informacji: Tomasz Pytlik, Krzysztof Świątkowski, Chris Monson, Bogdan
Polak



54. Jak wywołać domyślny program pocztowy z wpisanym już adresem odbiorcy?
email, adres, poczta
Należy skorzystać z funkcji WinAPI ShellExecute na przykład w ten sposób:
uses ShellApi;

procedure TForm1.Button1Click(Sender: TObject);
begin
ShellExecute(Handle,'open','mailto:wieczor@polbox.com','','',sw_Normal);
end;
Oprócz samego nadawcy można też podać tytuł i treść listu umieszczając jako
argument ShellExecute następujący tekst:
mailto:s_dusza@koti.com.pl?subject=test&body=Tu+jest+tresc
W podobny sposób można otworzyć okno Exploratora Windows podając nazwę katalogu
a także wywołać aplikację obsługującą dany format pliku.
Marcin Qfel Zaleski podesłał kod krzystający z funkcji MAPI. Dzięki MAPI można w
pełni kontrolować proces wysyłania poczty, w szczególności dodać do listu plik
jako załącznik:
procedure cos_tam;
var
MAPIFileDesc : TMAPIFileDesc;
MAPIMessage : TMAPIMessage;
MAPIRecipDesc : TMapiRecipDesc;
hMAPIDLL : THandle;
pfnMAPISendMail : TFNMAPISendMail;
begin

//załadowanie biblioteki
hMAPIDLL := LoadLibrary('MAPI32.DLL');
if hMAPIDLL=0 then
begin
//zle się dzieje
end;

//pobranie adresu funkcji
@pfnMAPISendMail := GetProcAddress(hMAPIDLL,'MAPISendMail');
if @pfnMAPISendMail=nil then
begin
FreeLibrary(hMAPIDLL);
//zle się dzieje
end;

//przygotowanie opisu adresata
FillChar(MAPIRecipDesc,SizeOf(TMAPIRecipDesc),0);
with MAPIRecipDesc do
begin
ulRecipClass := MAPI_TO;
lpszName := 'John Smith';
lpszAddress := 'johnsmith@server.com';
end;

//przygotowanie opisu załącznika
FillChar(MAPIFileDesc,SizeOf(TMAPIFileDesc),0);
with MAPIFileDesc do
begin
nPosition := Cardinal(-1);
lpszPathName := 'C:\Moje dokumenty\list.doc';
lpszFileName := 'list.doc';
end;

//przygotowanie rekordu wiadomości
FillChar(MAPIMessage,SizeOf(TMAPIMessage),0);
with MAPIMessage do
begin
lpszSubject := 'temat listu';
lpszNoteText := 'tresc listu';
nRecipCount := 1;
lpRecips := @MAPIRecipDesc;
nFileCount := 1;
lpFiles := @MAPIFileDesc;
end;

//wysłanie
if
pfnMAPISendMail(0,Handle,MAPIMessage,MAPI_DIALOG,0)<>SUCCESS_SUCCESS
then
begin
FreeLibrary(hMAPIDLL);
//zle się dzieje
end;
//zwolnienie zasobów
FreeLibrary(hMAPIDLL);
end;
Źródło informacji: Sebastian A. Dusza, Marcin Qfel Zaleski.



55. Dlaczego programy napisane w Delphi nie "fruną" na pasek zadań a po prostu się minimalizują, jak Windows 3.11?
minimalizacja, animacja, Win95, pasek zadań
Dlaczego, że programiści z Borland Int. wyłączyli animację okienek. Oddaję głos
Krzyśkowi Świątkowskiemu:
"Dlatego że przy minimalizacji chłopcy z Borlanda animację wyłączają, jak się ją
włączy to to głupio wygląda bo tak naprawdę minimalizuje się nie to okienko co
trzeba. Na upartego można to zrobić samemu funkcją API ale nie pamiętam jak się
nazywała."
Dlaczego Borland tak to rozwiązał?
"Żeby można było w każdej chwili wołać funkcje które wymagają uchwytu do okna
Application [Delphi M.W.] tworzy prawdziwe okno główne u siebie. To okno o
którym my mówimy że jest główne (MainForm) jest po prostu widoczne a prawdziwe
okno główne to od kolejki komunikatów aplikacji siedzi w TApplication. Po
zmianie tej funkcji o której wspomniałem widać animację okna głównego, czyli
tego co siedzi w Application a nie głównej formy i dlatego wygląda głupio. Ktoś
kiedyś mówił że na DSP jest komponent który pozwala to jako obejść. Ja znalazłem
jedynie obejście w postaci funkcji rysującej animacje ramki okna."
Jak to obejść?
"Przekompilować unit Forms tam jest jakaś taka funkcyjka która wyłącza animacje,
jak chcesz to mogę sprawdzić bo gdzieś mam chyba stare posty na ten temat"
Podejrzewam, że Krzyśkowi chodziło o funkcję:
procedure ShowWinNoAnimate(Handle: HWnd; CmdShow: Integer);
var
Animation: Boolean;
begin
Animation := GetAnimation;
if Animation then SetAnimation(False);
ShowWindow(Handle, CmdShow);
if Animation then SetAnimation(True);
end;
Jest ona wywoływana w kilku miejscach modułu Forms i należałoby ją zmienić na:
procedure ShowWinNoAnimate(Handle: HWnd; CmdShow: Integer);
begin
ShowWindow(Handle, CmdShow);
end;
W tym miejscu muszę dodać, że dobrze jest zrobić sobie kopię zapasową wszystkich
plików bibliotecznych (PAS, DCU, DPL itp.) przed rekompilacją bibliotek
standardowych.
Suplement
Ostatnio (dzięki Darkowi Brzezińskiemu) doszły nowe informacje. Aby poprawnie
działało minimalizowanie okien w Windows 95 należy:
W module projektu:
dodać do uses Windows,
zadeklarować zmienną np. ES : Integer;
po Application.Initialize dopisać:
ES:=GetWindowLong(Application.Handle, GWL_EXSTYLE);
ES:=ES or WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW;
SetWindowLong(Application.Handle,GWL_EXSTYLE,ES);
Okno z ustawionym stylem WS_EX_TOOLWINDOW nie jest pokazywane na pasku zadań.
W module głównego formularza aplikacji należy dodać:
procedure CreateParams(var Params:TCreateParams);override;
procedure WMSysCommand(var Message:TWMSysCommand);message WM_SYSCOMMAND;
...
procedure TForm1.CreateParams(var Params:TCreateParams);
begin
inherited CreateParams(Params);
with Params do ExStyle:=ExStyle or WS_EX_APPWINDOW;
end;

procedure TForm1.WMSysCommand(var Message:TWMSysCommand);
begin
if (Message.CmdType and $FFF0=SC_MINIMIZE) then WindowState:=wsMinimized
else inherited;
end;
Ominięcie domyślnej obsługi komunikatu, która wywołuje Application.Minimize. Po
tych zmianach minimalizuje się formularz (z animacją), a nie ukryte okno
aplikacji.
Źródło informacji: Darek Brzeziński, Krzysztof Świątkowski



56. Jak dostosować wydruk do różnych drukarek?
drukowanie, drukarka, rozdzielczość
Należy skorzystać z funkcji GetDeviceCaps z WinAPI i z modułu Printers. Na
przykład:
procedure TForm1.Button1Click(Sender: TObject);
var XD,YD:Integer;
begin
XD:=GetDeviceCaps(Printer.Handle,LogPixelSX); // liczba pikseli na cal w poziomie
YD:=GetDeviceCaps(Printer.Handle,LogPixelSY); // liczba pikseli na cal w poziomie
with Printer,Printer.Canvas do
begin
Title:='Wydruk próbny';
BeginDoc;
try
// Linia w poprzek całej kartki
MoveTo(PageWidth,0);LineTo(0,PageHeight);
// Linia o długości 1 cala
MoveTo(0,0);LineTo(XD,YD);
finally
EndDoc;
end;
end;
end;
To jednak nie koniec. Okazuje się, że NetManiak ma do tego kilka uwag:
"Już znalazłem formułę, dzięki której można dokładnie obliczyć ile musi mieć
pixeli linia, by na drukarce objawiła się jako 1 calowa. Teoretycznie powinno to
być (jak sugeruje kolega BACIK, tudzież dokumentacja windows) LOGPIXELSX i
LOGPIXELSY. Moje doświadczenia wskazują jednakże, iż rzeczywista wartość wynosi:

w poziomie: LOGPIXELX * PHYSICALWIDTH / HORZRES
w pionie: LOGPIXELSY * PHYSICALHEIGHT / VERTRES
gdzie LOGPIXELX - wynik funkcji GetDeviceCaps(LOGPIXELX ) itd...
Sprawdziłem to na 2 drukarkach: Cannon BJC4300 i HP (atramentówka, A4,
oznaczenia nie pamiętam)."
Źródło informacji: Adam K. "NetManiak".


57. Dlaczego nie działa StretchDraw dla ikon?
ikony, StretchDraw, rysowanie
Niedoróbka Delphi. Aby narysować rozciągniętą ikonę należy skorzystać z funkcji:
DrawIconEx(Canvas.Handle, 0, 0, Icon.Handle, szerokosc, wysokość, 0, 0,DI_NORMAL);


58. Dlaczego program korzystający z baz danych po przeniesieniu na inny komputer nie chce działać?
bazy danych, BDE, błąd
Delphi korzysta z BDE (Borland Database Engine). Jest to program pośredniczący
pomiędzy Delphi a bazami danych i musi być zainstalowany na docelowym
komputerze. Można to zrobić "ręcznie" - na kompakcie z Delphi jest katalog z
wersją instalacyjną samego BDE. Można też użyć InstallShield Express - jest to
okrojona wersja programu do tworzenia programów instalacyjnych. Znajduje się na
płycie z Delphi. Jedną z jego opcji jest właśnie instalowanie programów
wymagających BDE. Jest szybki i robi to całkiem nieźle.
Najczęstszym objawem braku BDE jest błąd nr 2109 z komunikatem "brak pliku
IDAPI32.DLL".



59. Jak reagować na zmianę rozdzielczości w trakcie działania programu?
rozdzielczość, ekran, zmiana
Należy obsłużyć komunikat wm_DisplayChange dopisując do formy procedurę:
procedure WMDisplayChange(var msg : TWMDisplayChange);message wm_DisplayChange;
Dodatkowo w Delphi 2.0 trzeba dopisać definicję typu:
type TWMDisplayChange = record
Msg: Cardinal;
BitsPerPixel: Integer;// ilość kolorów - 8-256, 15-32k, 16-64k,24/32-16mln
Width: Word; //szerokość
Height: Word; //wysokość
end;
Należy ją umieścić przed deklaracją procedury. Aby przeczytać o dodawaniu
własnej obsługi komunikatów zajrzyj do pytania 16.
Uwaga: Komunikat wm_DisplayChange jest specyficzny dla Windows 95 nie występuje
ani w Windows NT ani w Win32s API. Wczesne wersje Windows 95 mogą wysyłać ten
komunikat dwukrotnie - przed i po zmianie rozdzielczości.
Źródło informacji: Krzysztof Świątkowski.



60. Jak dodać wizytówkę programu (ang. splash screen)?
wizytówka, logo, splash, ładowanie
Należy stworzyć nową formę, nazwać ją np. TLogo, ustawić właściwości
BorderStylebsNone
BorderIcons[]
FormStylefsStayOnTop

Do formy dodać TImage z obrazkiem. Tak przygotowaną formę należy jeszcze usunąć
z listy automatycznie tworzonych form (jak to zrobić patrz pytanie 10). Teraz
przechodzimy do kodu źródłowego projektu.
begin
Application.Initialize;
// Utworzenie i pokazanie formy
Logo:=TLogo.Create(Application);
Logo.Show;
Logo.Update;

// Tu wstawia Delphi utworzenie automatycznych form
Application.Run;
end;
Do okna głównego dodajemy:
procedure TForm1.FormShow(Sender : TObject);
begin
if assigned(Logo) then
begin
Logo.Free;
Logo:=nil;
end;
end;
I gotowe. W katalogu DEMOS na płycie z Delphi znajduje się program MASTAPP z
winietą.



61. Jak dodać właściwości do formy aby były widoczne w okienku ObjectInspector?
właściwości, ObjectInspector, dziedziczenie, forma
Dokładnej odpowiedzi nie znam. Przytoczę tu fragment listu Roberta Perlińskiego:
"Niestety nie mogę odnaleźć kawałka kodu, który napisałem jakiś czas temu, a
który implementował dokładnie to o czym mówimy. Z głowy i z tego co pamiętam:
1. Tworzymy moduł z definicją formy np. TPawelForm, która zawiera "custom
property" np. PawelProperty. Forma powinna przeciążać konstruktor Create, ale
zamiast standardowego inherited powinna wołać CreateNew i InitInheritedComponent
(patrz TCustomForm.Create zdefiniowane w pliku forms.pas)
2. Tworzymy "Module Creator" np. TPawelFormCreator = class(TIModuleCreator)
3. Tworzymy "Expert" np. TPawelFormExpert = class(TIExpert)
4. Rejestrujemy TPawelForm i TPawelFormExpert
5. Jeśli w p. 1-4 zrobiliśmy wszystko jak należy, każda nowa forma utworzona
przy pomocy TPawelFormExpert, posiadać powinna PawelPropety dostępną z poziomu
Object Inspectora. Obiecuję, że jeśli odnajdę pełny tekst programu, wyślę go na
listę."
I tyle Robert. Niestety programu chyba nie wysłał (przynajmniej ja go nie
zauważyłem).
Źródło informacji: Robert Perliński



62. Jak pobrać listę właściwości obiektu w trakcie wykonywania programu?
właściwości, RTTI, runtime
Poniżej jest tłumaczenie Delphi TI 3166:
Czasem przydatna jest informacja o właściwościach komponentu w momencie
wykonywania programu. Listę właściwości można uzyskać przy pomocy funkcji
GetPropList. Typy, funkcje i procedury (włączając w to GetPropList) pozwalające
na dostęp do właściwości znajdują się w pliku TYPINFO.PAS.

GetPropList jest zdefiniowana jako:
function GetPropList(TypeInfo: PTypeInfo; TypeKinds: TTypeKinds;
PropList: PPropList): Integer;
Pierwszym parametrem GetPropList jest zmienna typu PTypeInfo, jest to część RTTI
(Run Time Type Information) dostępnej dla każdego obiektu. Typ ten jest
zdefiniowany następująco:
PPTypeInfo = ^PTypeInfo;
PTypeInfo = ^TTypeInfo;
TTypeInfo = record
Kind: TTypeKind;

Name: ShortString;
{TypeData: TTypeData}
end;
Rekord TTypeInfo może być odczytany przy pomocy właściwości ClassInfo obiektu.
Na przykład, jeśli pobieramy informacje o TButton wywołanie może wyglądać
następująco:
GetPropList(Button1.ClassInfo, ....
Drugi parametr (typu TTypeKinds) jest typu zbiorowego i działa jak filtr
decydując o tym jakie rodzaje właściwości zamieścić w liście. Jest kilka
możliwych wartości jakie można mu nadać jednakże tkProperties obsługuje
najważniejsze. Teraz wywołanie ma postać:
GetPropList(Button1.ClassInfo, tkProperties ....
Ostatni parametr, PPropList jest tablicą typów PPropInfo:
PPropList = ^TPropList;
TPropList = array[0..16379] of PPropInfo;
Teraz nasze wywołanie może mieć postać:
procedure TForm1.FormCreate(Sender: TObject);
var PropList: PPropList;
begin
PropList := AllocMem(SizeOf(PropList^));
GetPropList(TButton.ClassInfo, tkProperties + [tkMethod], PropList);
...
Przykład przytoczony poniżej pokazuje nie tylko nazwę właściwości ale także jej
typ. Nazwa typu znajduje się w dodatkowej strukturze w rekordzie TPropInfo.
Zauważmy, że pole PropType wskazuje na rekord TTypeInfo zawierający nazwę typu
właściwości:
PPropInfo = ^TPropInfo;
TPropInfo = packed record
PropType: PPTypeInfo;
GetProc: Pointer;
SetProc: Pointer;
StoredProc: Pointer;
Index: Integer;
Default: Longint;
NameIndex: SmallInt;
Name: ShortString;
end;

PPTypeInfo = ^PTypeInfo;
PTypeInfo = ^TTypeInfo;
TTypeInfo = record
Kind: TTypeKind;
Name: ShortString;
{TypeData: TTypeData}
end;
Poniższy kod przykładowy pokazuje jak wywołać GetPropList i jak odwoływać się do
elementów zwróconej tablicy. Przykład wymaga obecności na formie TListBox:
uses TypInfo;

procedure TMainForm.FormCreate(Sender: TObject);
var PropList: PPropList;
i: integer;
begin
PropList:=AllocMem(SizeOf(PropList^));
i:=0;
try
GetPropList(TForm.ClassInfo,tkProperties+[tkMethod],PropList);
while (PropList^[i]<>Nil)and(i begin
ListBox1.Items.Add(PropList^[i].Name+':'+PropList^[i].PropType^.Name);
Inc(i);
end;
finally
FreeMem(PropList);
end;
end;
Tyle Borland. Ze swej strony dodam, że aby powyższe działało obiekt musi być
kompilowany z włączeniem generowania RTTI lub być pochodną takiego obiektu. RTTI
jest włączone dla jednego obiektu z VCL - TPersistent. Wystarczy więc, że nasz
obiekt będzie pochodną TPersistent. To dla tych, którzy nie mają dostępu do
źródeł bibliotek. Dla pozostałych informacja jak włączyć generowanie RTTI.
Proszę spojrzeć na deklarację TPersistent:
{ TPersistent abstract class }

{$M+}

TPersistent = class(TObject)
private
procedure AssignError(Source: TPersistent);
protected
procedure AssignTo(Dest: TPersistent); virtual;
procedure DefineProperties(Filer: TFiler); virtual;
function GetOwner: TPersistent; dynamic;
public
destructor Destroy; override;
procedure Assign(Source: TPersistent); virtual;
function GetNamePath: string; dynamic;
end;

{$M-}
Widać, że za RTTI jest odpowiedzialny przełącznik {$M+} (można go zapisać też
jako {$TYPEINFO ON}). Polecam odpowiednią stronę w helpie. Jest tam między
innymi napisane, że RTTI jest generowane tylko dla pól w części published (nad
czym niezmiernie boleję).
Źródło informacji: Delphi TI 3166



63. Jak dodać własną pozycję do menu wywoływanego spod Exploratora po kliknięciu
prawym przyciskiem myszy?
Explorer, Explorator, menu podręczne, prawy przycisk myszy
Odpowiedź podał Michał Jaskólski:
procedure JakasTam;

var
Rejestr:TRegistry;
NazwaTypu:string;

begin
try
Rejestr:=TRegistry.Create;
Rejestr.RootKey := HKEY_CLASSES_ROOT;
Rejestr.OpenKey('\.rozszerzenie',true);
NazwaTypu:=Reg.ReadString('');
Rejestr.CloseKey;
Rejestr.OpenKey('\'+NazwaTypuHtml+'\shell\Koduj',true);
Rejestr.WriteString('','Koduj do...');
Rejestr.CloseKey;
Rejestr.OpenKey('\'+NazwaTypuHtml+'\shell\Koduj\command',true);
Rejestr.WriteString('','"'+Application.ExeName+'" "%1"');
Rejestr.CloseKey;
finally
Rejestr.Free;
end;
end;
Źródło informacji: Michał Jaskólski



64. Jak sprawdzić czy uruchomiony program jest już w pamięci?
powtórne uruchamianie, dwa programy
Odpowiedź podał Paweł Schmidt:
hMapping:=CreateFileMapping(THANDLE($FFFFFFFF),nil,
PAGE_READONLY,0,32,'ApplicationTestMap');
if GetLastError=ERROR_ALREADY_EXISTS then
begin
Application.MessageBox('Program jest już uruchomiony','Informacja',
mb_OK+MB_IconInformation);
Application.Terminate;
end;
Od siebie dodam, że przy końcu aplikacji warto zrobić CloseHandle(hMapping). W
Delphi 1.0 wystarczy sprawdzić wartość parametru HPrevInstance, jeśli jest
niezerowy to program został już uruchomiony.



65. Jak wyświetlić standardowe okno Windows służące do wybierania katalogu?
katalog, standardowe okno, dialog, wybór
Należy skorzystać z funkcji SHBrowseForFolder:
uses ShlObj,ActiveX;

procedure TForm1.Button1Click(Sender: TObject);
var BI:TBrowseInfo;
Buf:PChar;
Dir,Root:PItemIDList;
Alloc:IMalloc;
begin
// Pobieramy obiekt zarządzający pamięcią
SHGetMalloc(Alloc);
// Przydzielamy pamięć na string
Buf:=Alloc.Alloc(Max_Path);

// Ograniczamy wybór tylko do katalogu "Menu Start\Programs"
SHGetSpecialFolderLocation(Handle,CSIDL_PROGRAMS,Root);

with BI do
begin
hwndOwner:=Form1.Handle;
pidlRoot:=Root; // Tu można podać NIL żeby można było wybrać każdy katalog
pszDisplayName:=Buf;
lpszTitle:='Wybierz katalog'; // Etykietka przed listą katalogów
ulFlags:=0;
lpfn:=nil;
end;

try
Dir:=SHBrowseForFolder(BI);
if Dir<>Nil then
begin
// Pobieramy pełną ścieżkę do katalogu
SHGetPathFromIDList(Dir,Buf);
// Przykładowe zastosowanie
ShowMessage(Buf);
Alloc.Free(Dir);
end;
finally
Alloc.Free(Root);
Alloc.Free(Buf);
end;
end;
Inne możliwe do wybrania katalogi specjalne:
CSIDL_BITBUCKETRecycleBin czyli kosz na śmieci
CSIDL_CONTROLSWirtualny katalog ControlPanel
CSIDL_DESKTOPWirtualny katalog Desktop
CSIDL_DESKTOPDIRECTORYKatalog na dysku przechowujący obiekty z desktopu
CSIDL_DRIVESMy Computer
CSIDL_FONTSWirtualny folder z fontami
CSIDL_NETHOODOtoczenia sieciowe
CSIDL_NETWORKWirtualny odpowiednik powyższego
CSIDL_PERSONALKatalog Personal
CSIDL_PRINTERSWirtualny folder z drukarkami
CSIDL_PROGRAMSProgramy z menu Start
CSIDL_RECENTOstatnio użyte dokumenty
CSIDL_SENDTOFolder SendTo
CSIDL_STARTMENUCałe StartMenu
CSIDL_STARTUPGrupa Autostart
CSIDL_TEMPLATESSzablony dokumentów

Wartości CSIDL_PROGRAMS można użyć przy dodawaniu własnych pozycji w menu Start.



66. Czy jest możliwe skompilowanie programu napisanego w Delphi 3.0 tak aby działał w Windows 3.11?
Windows 3.11, thunk, Win32s, 16-bit
Nie próbowałem tego w Delphi 3.0 ale kompilowałem kilka programów pod Delphi 2.0
korzystających z wielu komponentów Delphi (ale nie korzystałem bezpośrednio z
WinAPI) i nie było żadnych problemów z uruchomieniem ich pod Windows 3.11.
Oczywiście w docelowym systemie musi być zainstalowana nakładka Win32s. Jeśli
chcesz korzystać bezpośrednio z WinAPI to sprawdź czy funkcja, której używasz ma
swój odpowiednik w Win32s API. Pod Delphi 3.0 nie powinno być żadnych problemów
pod warunkiem, że nie korzystamy z obiektów z zakładki Win32. Dodam jeszcze, że
moje programy nie korzystały z baz danych (co nie znaczy, że takowe nie będą
działać, po prostu testy musisz przeprowadzić we własnym zakresie).



67. Gdzie i za ile można kupić Delphi, gdzie można znaleźć informację o tym produkcie?
Delphi, kupno, BSC
Dystrybutorem produktów Borlanda w Polsce jest Borland Support Center. Tam też
znajdują się aktualne ceny. Informacje można znaleźć na wspomnianym BSC jak
również na stronach Inprise (dawniej Borland).
Niektórzy twierdzą, iż taniej jest sprowadzić Delphi ze Stanów niż kupować w
Polsce.

68. Jak odczytać numer seryjny dysku lub dyskietki?
numer seryjny, dysk, dyskietka, CD-ROM
Dla dyskietki działa poniższy kod:
var
Buf:array[0..MAX_PATH] of Char;
NotUsed,VolFlags:Integer;
DriveChar:Char;
Serial:PDWORD;
begin
DriveChar := 'a';
GetVolumeInformation(PChar(DriveChar + ':\'),Buf,sizeof(Buf),
@Serial,NotUsed,VolFlags,nil,0);
end;
W zmiennej Serial jest numer dyskietki.
Krzysztof Świątkowski podesłał rozwiązanie tego problemu działające również dla
twardych dysków:
// (c) Alex Konshin mailto:alexk@mtgroup.ru 30 jul 2000

program HDDSerial;

// PURPOSE: Simple console application that extract first IDE disk serial
number.

uses
Windows,
SysUtils; // only for Win32Platform and SysErrorMessage

//-------------------------------------------------------------
function GetIdeDiskSerialNumber : String;
type
TSrbIoControl = packed record
HeaderLength : ULONG;
Signature : Array[0..7] of Char;
Timeout : ULONG;
ControlCode : ULONG;
ReturnCode : ULONG;
Length : ULONG;
end;
SRB_IO_CONTROL = TSrbIoControl;
PSrbIoControl = ^TSrbIoControl;

TIDERegs = packed record
bFeaturesReg : Byte; // Used for specifying SMART "commands".
bSectorCountReg : Byte; // IDE sector count register
bSectorNumberReg : Byte; // IDE sector number register
bCylLowReg : Byte; // IDE low order cylinder value
bCylHighReg : Byte; // IDE high order cylinder value
bDriveHeadReg : Byte; // IDE drive/head register
bCommandReg : Byte; // Actual IDE command.
bReserved : Byte; // reserved. Must be zero.
end;
IDEREGS = TIDERegs;
PIDERegs = ^TIDERegs;

TSendCmdInParams = packed record
cBufferSize : DWORD;
irDriveRegs : TIDERegs;
bDriveNumber : Byte;
bReserved : Array[0..2] of Byte;
dwReserved : Array[0..3] of DWORD;
bBuffer : Array[0..0] of Byte;
end;
SENDCMDINPARAMS = TSendCmdInParams;
PSendCmdInParams = ^TSendCmdInParams;

TIdSector = packed record
wGenConfig : Word;
wNumCyls : Word;
wReserved : Word;
wNumHeads : Word;
wBytesPerTrack : Word;
wBytesPerSector : Word;
wSectorsPerTrack : Word;
wVendorUnique : Array[0..2] of Word;
sSerialNumber : Array[0..19] of Char;
wBufferType : Word;
wBufferSize : Word;
wECCSize : Word;
sFirmwareRev : Array[0..7] of Char;
sModelNumber : Array[0..39] of Char;
wMoreVendorUnique : Word;
wDoubleWordIO : Word;
wCapabilities : Word;
wReserved1 : Word;
wPIOTiming : Word;
wDMATiming : Word;
wBS : Word;
wNumCurrentCyls : Word;
wNumCurrentHeads : Word;
wNumCurrentSectorsPerTrack : Word;
ulCurrentSectorCapacity : ULONG;
wMultSectorStuff : Word;
ulTotalAddressableSectors : ULONG;
wSingleWordDMA : Word;
wMultiWordDMA : Word;
bReserved : Array[0..127] of Byte;
end;
PIdSector = ^TIdSector;

const
IDE_ID_FUNCTION = $EC;
IDENTIFY_BUFFER_SIZE = 512;
DFP_RECEIVE_DRIVE_DATA = $0007c088;
IOCTL_SCSI_MINIPORT = $0004d008;
IOCTL_SCSI_MINIPORT_IDENTIFY = $001b0501;
DataSize = sizeof(TSendCmdInParams)-1+IDENTIFY_BUFFER_SIZE;
BufferSize = SizeOf(SRB_IO_CONTROL)+DataSize;
W9xBufferSize = IDENTIFY_BUFFER_SIZE+16;
var
hDevice : THandle;
cbBytesReturned : DWORD;
pInData : PSendCmdInParams;
pOutData : Pointer; // PSendCmdOutParams
Buffer : Array[0..BufferSize-1] of Byte;
srbControl : TSrbIoControl absolute Buffer;


procedure ChangeByteOrder( var Data; Size : Integer );
var ptr : PChar;
i : Integer;
c : Char;
begin
ptr := @Data;
for i := 0 to (Size shr 1)-1 do
begin
c := ptr^;
ptr^ := (ptr+1)^;
(ptr+1)^ := c;
Inc(ptr,2);
end;
end;

begin
Result := '';
FillChar(Buffer,BufferSize,#0);
if Win32Platform=VER_PLATFORM_WIN32_NT then
begin // Windows NT, Windows 2000
// Get SCSI port handle
hDevice := CreateFile( '\\.\Scsi0:',
GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE,
nil, OPEN_EXISTING, 0, 0 );
if hDevice=INVALID_HANDLE_VALUE then Exit;
try
srbControl.HeaderLength := SizeOf(SRB_IO_CONTROL);
System.Move('SCSIDISK',srbControl.Signature,8);
srbControl.Timeout := 2;
srbControl.Length := DataSize;
srbControl.ControlCode := IOCTL_SCSI_MINIPORT_IDENTIFY;
pInData := PSendCmdInParams(PChar(@Buffer)
+SizeOf(SRB_IO_CONTROL));
pOutData := pInData;
with pInData^ do
begin
cBufferSize := IDENTIFY_BUFFER_SIZE;
bDriveNumber := 0;
with irDriveRegs do
begin
bFeaturesReg := 0;
bSectorCountReg := 1;
bSectorNumberReg := 1;
bCylLowReg := 0;
bCylHighReg := 0;
bDriveHeadReg := $A0;
bCommandReg := IDE_ID_FUNCTION;
end;
end;
if not DeviceIoControl( hDevice, IOCTL_SCSI_MINIPORT,
@Buffer, BufferSize, @Buffer, BufferSize,
cbBytesReturned, nil ) then Exit;
finally
CloseHandle(hDevice);
end;
end
else
begin // Windows 95 OSR2, Windows 98
hDevice := CreateFile( '\\.\SMARTVSD', 0, 0, nil,
CREATE_NEW, 0, 0 );
if hDevice=INVALID_HANDLE_VALUE then Exit;
try
pInData := PSendCmdInParams(@Buffer);
pOutData := @pInData^.bBuffer;
with pInData^ do
begin
cBufferSize := IDENTIFY_BUFFER_SIZE;
bDriveNumber := 0;
with irDriveRegs do
begin
bFeaturesReg := 0;
bSectorCountReg := 1;
bSectorNumberReg := 1;
bCylLowReg := 0;
bCylHighReg := 0;
bDriveHeadReg := $A0;
bCommandReg := IDE_ID_FUNCTION;
end;
end;
if not DeviceIoControl( hDevice, DFP_RECEIVE_DRIVE_DATA,
pInData, SizeOf(TSendCmdInParams)-1, pOutData,
W9xBufferSize, cbBytesReturned, nil ) then Exit;
finally
CloseHandle(hDevice);
end;
end;
with PIdSector(PChar(pOutData)+16)^ do
begin
ChangeByteOrder(sSerialNumber,SizeOf(sSerialNumber));
SetString(Result,sSerialNumber,SizeOf(sSerialNumber));
end;
end;


//=============================================================
var s : String;
rc : DWORD;
begin
s := GetIdeDiskSerialNumber;
if s='' then
begin
rc := GetLastError;
if rc=0 then MessageBox(0,'IDE drive is not support SMART
feature','',0)
else MessageBox(0,PChar(SysErrorMessage(rc)),'',0);
end
else MessageBox(0,PChar('Disk serial number: '''+ s+''''),'',0);
end.
Źródło informacji: Artur Bajor, Krzysztof Świątkowski, Alex Konshin.


69. Napisałem program korzystający z THTML i po przeniesieniu na inny komputer pojawia się błąd "Exception EOleSysError in module..." co się dzieje?
EOleSysError, OCX, HTML
Komponent THTML trzeba zarejestrować gdyż jest to kontrolka OCX. Można zrobić to
używając programu regsrv32.exe lub ręcznie na początku programu. Większy problem
to to, że ta kontrolka składa się z kilku plików i wszystkie trzeba przenieść do
komputera docelowego do katalogu Windows\System lub katalogu z Twoim programem.
Jakie pliki przenieść można sprawdzić w dokumentacji kontrolki lub sprawdzając w
QuickView jakich bibliotek używa (poza standardowymi z Windows). Metodą czołgową
można również kopiować po jednym pliku gdyż komunikaty o błędach podają czasem,
którego pliku brakuje. Poniżej podaję procedury do rejestracji kontrolek OCX:
function CheckOCX:Boolean;
var Reg:TRegistry;
begin
Reg:=TRegistry.Create;
try
Reg.RootKey:=HKEY_CLASSES_ROOT;
// Poniżej jest UID kontrolki wyciągnięty z rejestru Windows
Result:=Reg.OpenKey('CLSID\{B7FC3550-8CE7-11CF-9754-00AA00C00908}',False);
if Result then Reg.CloseKey;
finally
Reg.Free;
end;
end;
procedure RegisterOCX;
var Lib:THandle;
S:String;
P:TProcedure;
begin
OleInitialize(nil);
try
S:=ExtractFilePath(Application.ExeName)+'HTML.OCX';
Lib:=LoadLibrary(PChar(S));
if Libraise Exception.CreateFmt('Cannot initialize library %s. '+
'Internal Windows error %d',[S,Lib]);
try
P:=GetProcAddress(Lib,'DllRegisterServer');
if not Assigned(P) then raise Exception.Create('Cannot find '+
'procedure DllRegisterServer');
P;
finally
FreeLibrary(Lib);
end;
finally
OleUninitialize;
end;
end;
procedure Uninstall;
var Lib:THandle;
S:String;
P:TProcedure;
begin
S:=ExtractFilePath(Application.ExeName)+'HTML.OCX';
Lib:=LoadLibrary(PChar(S));
if Libraise Exception.CreateFmt('Cannot initialize library %s.'+
' Internal Windows error %d',[S,Lib]);
try
P:=GetProcAddress(Lib,'DllUnregisterServer');
if not Assigned(P) then raise Exception.Create('Cannot find procedure '+
'DllUnregisterServer');
P;
finally
FreeLibrary(Lib);
end;
end;
Powinno się udostępnić opcję wymuszenia instalacji komponentu. Miałem problem
gdy komponent był zarejestrowany ale nie było go na dysku.Wtedy pojawiał się
błąd. Dzieje się tak najczęściej na komputerach, na których ktoś wcześniej
instalował Delphi. Możliwe, że uninstall z Delphi nie usuwa wpisów w rejestrze a
usuwa pliki. Aby powyższe działało można:
wrzucić wszystkie pliki kontrolki do katalogu z programem
na początku projektu sprawdzać czy kontrolka jest zarejestrowana
jeśli nie jest to ją zarejestrować
jeśli jest to zapamiętać, że jest
na końcu programu (przy wyjściu) odrejestrować kontrolkę ale tylko wtedy gdy
nie była zarejestrowana przed wywołaniem programu
jeśli ktoś użyje parametru przy uruchomieniu programu to traktować ten
przypadek jako brak instalacji kontrolki
Można też sprawdzanie instalacji zamienić na próbne utworzenie kontrolki. Jeśli
Delphi rzuci wyjątek EOleSysError to znaczy, że trzeba ją zainstalować. IMHO
OCX-y są trochę niewygodne. Wolę komponenty "100% pure Delphi". Przykładowe
procedury były pisane do komponentu THTML. Aby rejestrować inne komponenty
trzeba znać ich GUID i nazwę pliku, w którym się znajdują. Informacje te można
wziąć z dokumentacji lub rejestru Windows.



70. Jak wywołać program 32-bitowy i poczekać na jego zakończenie?
wywołanie, 32-bit
Można skorzystać z poniższego przykładu:
procedure TForm1.Button1Click(Sender: TObject);
var SI:TStartupInfo;
PI:TProcessInformation;
S,Dir:String;
begin
Dir:=ExtractFilePath(Application.ExeName);
S:='winrar95.exe a '+Dir+'test.rar '+Dir+'*.*';

FillChar(SI,sizeof(SI),0);
with SI do
begin
dwFlags:=STARTF_USESHOWWINDOW;
wShowWindow:=SW_SHOW;
cb:=sizeof(TStartupInfo);
end;

if CreateProcess(nil,PChar(S),nil,nil,FALSE,NORMAL_PRIORITY_CLASS,nil,nil,SI,PI) then
with PI do
begin
WaitForInputIdle(hProcess,1000);
WaitForSingleObject(hProcess,10000);
WaitForSingleObject(hThread,10000);
CloseHandle(hProcess);
CloseHandle(hThread);
end;
end;
Oczywiście trzeba zmienić wartości przekazywane w zmiennej S ale idea pozostaje
ta sama.
Źródło informacji: Marian Ficek


71. Jak dodać skrót do Desktopu lub Menu Start w Windows 95?
skrót, pasek Start, menu, desktop, ikona
Poniższe pochodzi z Delphi TI 3234:
Poniższy przykład pokazuje jak dodać skróty na desktop i menu Start w Windows 95
i Windows NT 4.0. Skrót zostanie dodany w jednym z tych miejsc (patrz kod).
Położenie desktopu i menu Start pobierane jest z rejestru (z gałęzi
HKEY_CURRENT_USER):
Software\MicroSoft\Windows\CurrentVersion\Explorer\Shell Folders
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','')+
// '\Whoa!';// CreateDir(Directory);

WFileName := Directory+'\FooBar.lnk';
MyPFile.Save(PWChar(WFileName),False);
MyReg.Free;
end;
Źródło informacji: Delphi TI 3234.



72. Mam problemy z bazami danych w sieci, nie pojawiają się zmiany w bazach.
sieć, BDE, bazy danych, Paradox
Oto co na ten temat pisze Krzysztof Szyszka
"Ponieważ już parę razy odpowiadałem na pytania dotyczące różnych problemów
związanych z pracą w sieci na bazach dBase i Paradox, a pytania ciągle się
pojawiają, więc pokuszę się o krótkie zebranie zaleceń wynikających z moich
własnych doświadczeń. (...)
Ustawić w BDE Administratorze parametr Configuration/System/INIT/LOCAL SHARE
na True na wszystkich stacjach, jeśli korzystamy z sieci typu peer-to-peer np.
Microsoft Network.
Dla baz Paradoxa ustawić Configuration/Drivers/Native/PARADOX/NET DIR lub
Session.NetFileDir na ten sam fizycznie plik PDOXUSRS.NET. Niektórzy zalecają
umieścić ten plik w katalogu baz danych.
Ustawić Session.PrivateDir na roboczy katalog lokalnego dysku, chyba że mamy
pewność, że bieżącym katalogiem przy starcie programu będzie katalog na
lokalnym dysku.
Zostawić domyślne ustawienie Table.CachedUpdates na False. Przy ustawieniu na
True należy być świadomym, że wszystkie operacje na bazie wykonywane są
jedynie w pamięci bez zapisu na dysk, a więc i bez wykonywania funkcji
sieciowych.
W zdarzeniu AfterPost każdej tabeli danych wymusić zapis buforów BDE na dysk
poleceniem: Check(dbiSaveChanges(Table.Handle)). Dla tabel służących do
przetwarzania większej porcji rekordów można wykonać to po zakończeniu
aktualizacji, jeśli nie dokonujemy zmian w polach kluczowych dla pracy w
sieci. Z punktu widzenia bezpieczeństwa danych lepiej wykonywać to po każdym
Post, kosztem szybkości przetwarzania rekordów.
Po wykonaniu każdego polecenia dostępnego użytkownikowi, które operuje na
bazach danych, należy wykonać Table.Refresh dla uwidocznienie zmian dokonanych
ostatnio w bazie przez innych użytkowników. Ma to szczególne znaczenie wtedy,
gdy polecenie zakończy się komunikatem o błędzie np. 'Record locked by another
user.', 'No current record.', 'Rekord/Key deleted.', itp.
Dla tabel podłączonych do komponentów, które operują jednocześnie na więcej
niż jednym rekordzie danych (np. DBGrid) wykonać dodatkowo DBGrid.Refresh, dla
uwidocznienie zmian w pozostałych wierszach danych. W programach które
prezentują jednocześnie kilka okien danych warto podłączyć Table.Refresh (i
DBGrid.Refresh) pod zdarzenie OnActivate, żeby uczynienie okna aktywnym,
wiązało się zawsze z odświeżeniem danych.
Wykonując instalacje programu wymagającego BDE przy pomocy InstallShielda
można dopisać własne Aliasy, ale nie można spowodować zmian w parametrach z
zakładki Configuration (w każdym razie mnie się to nie udało), dlatego warto
zmodyfikować ręcznie plik \InstallShield\redist\IDAPI32.CNF, dokonując np.
zmiany domyślnego ustawienia dla LOCAL SHARE na True."
Źródło informacji: Krzysztof Szyszka



73. Jak przeszukiwać Delphi Help i Win32 Help jednocześnie?
help, pomoc, przeszukiwanie
Należy dopisać poniższy tekst do Delphi3.CNT:
:Index Win32=win32.hlp
wtedy w indeksie jest zarówno Delphi jak i WinAPI.
Źródło informacji: Krzysztof Świątkowski



74. Przy próbie dodania nowego rekordu do tabeli Paradoxa pojawia się błąd "Index is read-only". Przy ustawianiu nazwy indeksu wyskakuje wyjątek "Index is out of date".
Paradox, indeksy
Dla tabel Paradox'a indeksy typu secondary nie mogą być modyfikowane bez
istnienia indeksu primary. Rozwiązać to można na 2 sposoby:
- przez dodanie primary index w Database Desktop,
- dodawanie danych do tabeli bez ustawionego indeksu, a następnie przez ponowne
utworzenie indeksów w Database Desktop ręcznie lub programowo przy użyciu
poniższego kodu:
try
Table1.Active:=False;
Table1.Exclusive:=True;
Table1.Active:=True;
Check(DbiRegenIndexes(Table1.Handle));
finally
Table1.Active:=False;
Table1.Exclusive:=False;
Table1.Active:=True;
end;
Table1 nie może posiadać ustawionego indeksu w IndexFieldNames ani IndexName.
Źródło informacji: Krzysztof Borys.

75. Jak usunąć przycisk programu z paska zadań?
pasek zadań, ikona, przycisk
Należy:
W module projektu:
dodać do uses Windows,
zadeklarować zmienną np. ES : Integer;
po Application.Initialize dopisać
ES:=GetWindowLong(Application.Handle, GWL_EXSTYLE);
ES:=ES or WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW;
SetWindowLong(Application.Handle,GWL_EXSTYLE,ES);
Okno z ustawionym stylem WS_EX_TOOLWINDOW nie jest pokazywane na pasku zadań.
Źródło informacji: Darek Brzeziński



76. Jak dodać swój program obok ikonki zegara w Windows 95?
pasek zadań, tray, szuflada, ikona, zegar
Poniżej znajduje się przetłumaczony tekst Brendana Delumpa (tu podziękowania dla
Radka "Radio Erewan" Przybyła za wyszukanie go w odmętach Sieci):
"Zabawne jak niektóre rzeczy w Windows, które wyglądają na proste w
implementacji okazują się być bardzo stresujące. I nie jest tak dlatego, że są
to trudne rzeczy - często po porostu informacje potrzebne do ukończenia programu
kryją się za wieloma odnośnikami WWW, stronami helpa lub nie ma ich tam gdzie
spodziewalibyśmy się je znaleźć (częste luki w dokumentacji Delphi). Tak również
jest z tworzeniem aplikacji umieszczającej ikonę w obszarze systemowego traya
(szuflady). Implementacja tego efektu jest trywialna ale dotarcie do potrzebnych
informacji nie jest proste.
Są dwie rzeczy, które trzeba wziąć pod uwagę tworząc aplikację do traya.
Pierwsza to "ukrycie" aplikacji przed Windows. Mimo, że aplikacje takie
wyglądają i zachowują się jak zwykłe aplikacje Windows, nie można się na nie
przełączyć przy użyciu Alt-Tab ani nie mają swojego przycisku na pasku zadań.
Tym zajmiemy się najpierw.
Każde okno posiadające styl WS_EX_TOOLWINDOW ani nie ma przycisku na pasku zadań
ani nie można się na nie przełączyć. Z początku może wydawać się właściwym
ustawienie tego stylu przy użyciu CreateParams. Niestety nie zadziała to dla
formy. Tu mała dygresja. Główna forma aplikacji nie jest oknem (w terminologii
Windows) aplikacji. Obiekt aplikacji ma swoje własne okno - nie można go
zobaczyć ale ono "tam" jest. To jest właśnie to okno, do którego należy
przypisać styl WS_EX_TOOLWINDOW. Gdzie więc należy wstawić kod? Oczywiście w
źródle projektu. Po wybraniu View|Project Source należy skopiować poniższy kod:
program Project1;
uses Forms,
Unit1 in 'Unit1.pas' {Form1},
Windows; //To jest wymagane aby znana była stała WS_EX_TOOLWINDOW i pozostałe
{$R *.RES}
//Deklaracja zmiennej do przyjęcia informacji o stylu okna
var ExtendedStyle : Integer;
begin
Application.Initialize;
//Pobranie informacji o oknie aplikacji przy użyciu GetWindowLong
ExtendedStyle:=GetWindowLong(Application.Handle, GWL_EXSTYLE);

//Teraz ustawiamy styl rozszerzony przy użyciu operacji na bitach
//Przekształca to okno z okna-aplikacji do okna-narzędzia
SetWindowLong(Application.Handle,GWL_EXSTYLE,
ExtendedStyle or WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW);
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
A teraz aby utworzyć właściwy efekt aplikacji w trayu będziemy potrzebowali
przede wszystkim głównej formy aplikacji. Połóż na formie komponent TPopupMenu.
Będzie to główny interfejs do naszej aplikacji. Popatrz na poniższy kod:
{ Poniższe umieszcza aplikację w trayu.
Jest to główna forma aplikacji. Posiada ona menu popup używane do
wyświetlenia formy i zamknięcia aplikacji.
Używając modułu ShellApi w prosty sposób pokażemy ikonę aplikacji w trayu
i spowodujemy aby reagowała na kliknięcia myszą }

unit Unit1;

interface

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

type
TForm1 = class(TForm)
PopupMenu1: TPopupMenu;
ShowMainForm1: TMenuItem;
N1: TMenuItem;
ExitApplication1: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure ShowMainForm1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ExitApplication1Click(Sender: TObject);
private
procedure WndProc(var Msg : TMessage); override;
public
IconNotifyData : TNotifyIconData;
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
// Zostawiamy tylko przycisk zamykający okno
BorderIcons := [biSystemMenu];

// Teraz wypełniamy rekord IconNotifyData tak aby przyjmował
// komunikaty wysyłane do aplikacji i pokazywał "dymki" podpowiedzi.
with IconNotifyData do begin
hIcon:=Application.Icon.Handle;
uCallbackMessage:=WM_USER+1;
cbSize:=SizeOf(IconNotifyData);
Wnd:=Handle;
uID:=100;
uFlags:=NIF_MESSAGE+NIF_ICON+NIF_TIP;
end;
// Kopiujemy tytuł aplikacji jako "dymek"
StrPCopy(IconNotifyData.szTip, Application.Title);

// Dodajemy ikonę do traya
Shell_NotifyIcon(NIM_ADD,@IconNotifyData);
end;

procedure TForm1.WndProc(var Msg : TMessage);
var
p : TPoint;
begin
if (Msg.Msg=WM_USER+1)and(Msg.lParam=WM_RBUTTONDOWN) then
begin
GetCursorPos(p);
PopupMenu1.Popup(p.x, p.y);
end;
inherited;
end;

// To jedna z procedur obsługi elementów menu
procedure TForm1.ShowMainForm1Click(Sender: TObject);
begin
Form1.Show;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caNone;
Form1.Hide;
end;

procedure TForm1.ExitApplication1Click(Sender: TObject);
begin
Shell_NotifyIcon(NIM_DELETE, @IconNotifyData);
Application.ProcessMessages;
Application.Terminate;
end;

end.
Jak widać nie ma wiele do zrobienia. Ale ważne jest aby rozumieć co zrobiliśmy w
metodzie Create i jakie znaczenie ma rekord IconNotifyData. Jest to rekord
zdefiniowany w module ShellAPI, który przechowuje informację o ikonie w trayu.
Zauważ flagi, których użyliśmy: NIF_MESSAGE + NIF_ICON + NIF_TIP. Oznaczają one
kolejno: obsługę komunikatów dla aplikacji, pokazywanie ikony aplikacji i
pokazywanie "dymku" z podpowiedzią.
Następna sprawa to nadpisanie procedury WndProc (skrót od WindowProcedure).
Dostaje ona wszystkie komunikaty przesyłane do okna i zachowuje się jak
centralna rozdzielnia komunikatów. Można przejąć obsługę komunikatu pisząc
własną jego obsługę i wywołując odziedziczoną procedurę. Przy obsłudze
komunikatu sprawdzamy czy jest to nasz własny (wm_User+1) zdefiniowany w
zmiennej IconNotifyData oraz czy nastąpiło kliknięcie prawym przyciskiem myszy.
Pozostałe komunikaty przesyłamy bez zmian.[...]"
Źródło informacji; Brendan Delupma, Radosław "Radio Erewan" Przybył



77. Jak odegrać dźwięk przechowywany w zasobach?
dzwięk, zasoby, WAV, WAVE
Należy skorzystać z poniższego kodu:
var FindHandle, ResHandle: THandle;
ResPtr: Pointer;
begin
FindHandle:=FindResource(HInstance, 'TUTAJ NAZWA ZASOBU', 'WAVE');
if FindHandle<>0 then
begin
ResHandle:=LoadResource(HInstance, FindHandle);
if ResHandle<>0 then
begin
ResPtr:=LockResource(ResHandle);
if ResPtr<>Nil then
SndPlaySound(PChar(ResPtr), snd_ASync or snd_Memory);
UnlockResource(ResHandle);
end;
FreeResource(FindHandle);
end;
end;
Krzysztof Świątkowski zwrócił uwagę na prostszą metodę możliwą jednak do
wykorzystania tylko w Win32. Jeśli mamy zasób typu WAVE wystarczy tylko wykonać:
PlaySound('MUZYKA', hInstance, SND_RESOURCE or SND_ASYNC);
hInstance jest uchwytem do instancji aplikacji lub biblioteki. W ten sposób
można np odtworzyć WAVE zapisany w jakimś dll'u.
Źródło informacji: Stefan Westner, Krzysztof Świątkowski



78. Jak schować lub wyłączyć przycisk start w Win95?
przycisk Start, pasek zadań
Należy wykonać poniższy kod:
procedure TForm1.Button1Click(Sender: TObject);
var
Rgn : hRgn;
begin
//Ukrycie przycisku Start
Rgn := CreateRectRgn(0, 0, 0, 0);
SetWindowRgn(FindWindowEx(FindWindow('Shell_TrayWnd', nil),0,'Button',nil),Rgn,true);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
//Przywrócenie przycisku
SetWindowRgn(FindWindowEx(FindWindow('Shell_TrayWnd', nil),0,'Button',nil),0,true);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
//Wyszarzenie przycisku Start
EnableWindow(FindWindowEx(FindWindow('Shell_TrayWnd', nil),0,'Button',nil),false);
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
//Ponowne włączenie przycisku
EnableWindow(FindWindowEx(FindWindow('Shell_TrayWnd', nil),0,'Button',nil),true);
end


79. Czy jest coś dokładniejszego niż TTimer?
TTimer, zegar, przerwanie
Należy użyć procedury QueryPerformanceFrequency. Oto przykład:
procedure TForm1.Button1Click(Sender: TObject);
var
li : TLARGEINTEGER;
begin
QueryPerformanceFrequency(li);
ShowMessage(FloatToStr(Comp(li)));
QueryPerformanceCounter(li);
ShowMessage(FloatToStr(Comp(li)));
QueryPerformanceCounter(li);
ShowMessage(FloatToStr(Comp(li)));
end;
Jak widać TLargeInteger jest kompatybilny wewnętrznie z Comp i może być na niego
rzutowany.


80. Jak utworzyć lub odtworzyć indeksy dla istniejących tabel?
indeks, Paradox
Należy skorzystać z metody AddIndex:
Table1.AddIndex('NewIndex','CustNo;CustName',[ixUnique,ixCaseInsensitive]);
zaś aby odtworzyć indeks:
Check(dbiRegenIndexes(Table1.Handle));
Użycie dbiRegenIndexes może wymagać dodania modułu BDE do klauzuli uses, zaś
tabele powinny być otwarte w trybie wyłączności.
Źródło informacji: Tomasz Hejman, Krzysztof Borys


81. Mimo że usuwam rekordy z bazy to jej rozmiar nie zmniejsza się, co robić?
rozmiar bazy, rekordy, BDE, pakowanie, kasowanie
Paradox (i inne bazy) nie usuwają fizycznie rekordu z bazy a tylko zaznaczają go
jako usuniętego. Przyspiesza to operacje na rekordach. Aby odzyskać zajmowane
przez te rekordy miejsce należy użyć procedur pakujących tabelę.
W klauzuli uses dopisujemy:
uses DbiProcs,DbiTypes,DbiErrs;
A potem:
function TForm1.PackTable():DbiResult;
var
Props: CURProps;
hDb: hDBIDb;
TableDesc: CRTblDesc;
begin
if Table1.Active then
Table1.Active := False;
try
Table1.Exclusive:=True;
Table1.Active:=True;
except
ShowMessage('Błąd: Nie mogę otworzyć tabeli ' + Table1.TableName + ' na wyłączność;'
+ #13#10 + 'prawdopodobnie jest uszkodzona, lub tabela jest w używana');
Result:=66;
Exit;
end;

// Pobieramy właściwości tabeli aby sprawdzić jej typ...
Check(DbiGetCursorProps(Table1.Handle, Props));

// Jeśli to tabela Paradoxa, wywołujemy DbiDoRestructure...
if Props.szTableType = szPARADOX then
begin
// Zerujemy rekord...
FillChar(TableDesc, sizeof(TableDesc), 0);
// Pobieramy uchwyt tabeli z uchwytu kursora...
Check(DbiGetObjFromObj(hDBIObj(Table1.Handle), objDATABASE, hDBIObj(hDb)));
// Przepisujemy nazwę tabeli...
StrPCopy(TableDesc.szTblName, Table1.TableName);
// i jej typ...
StrPCopy(TableDesc.szTblType, Props.szTableType);
// Ustawiamy opcję Pack na TRUE...
TableDesc.bPack := True;
// Zamykamy tabelę (dBase oczekuje otwartej tabeli)
Table1.Close;
// Wywołujemy DbiDoRestructure...
Result:=DbiDoRestructure(hDb, 1, @TableDesc, nil, nil, nil, FALSE);
Check(Result);
end
else
begin
// Jeśli to tabela dBASE to po prostu wywołujemy DbiPackTable...
if Props.szTableType = szDBASE then
Result:=DbiPackTable(Table1.DBHandle, Table1.Handle, nil, szDBASE, TRUE)
else
// To wszystko działa tylko dla tabel Paradoksa i dBASE...
raise EDatabaseError.Create('Tabela musi być typu Paradox lub dBASE ' +
'aby można ją było pakować');
end;
Table1.Active:=False;
Table1.Exclusive:=False;
end;
Pozostaje jeszcze wywołać tę procedurę:
if Form1.PackTable = DbiERR_NONE then
begin
MessageDlg('Pakowanie tabeli zakończone sukcesem.',mtInformation,[mbOK],0);
end
else
MessageDlg('Pakowanie tabeli nie powiodło się.',mtWarning,[mbOK],0);
Źródło informacji: Piotr Murawski


82. Jak odczytać lokalny adres IP?
adres IP, internet
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


83. Jak zablokować przełączanie zadań przy pomocy Alt-Tab lub Ctrl-Tab?
Alt, Tab, zadania, przełączanie
Należy oszukać Windows tak aby myślało, że nasza aplikacja jest wygaszaczem
ekranu. Poniższy sposób działa tylko w Windows 95, nie działa w NT i nie ma
gwarancji, żeby działał w przyszłych wersjach Windows.
var OldValue:LongBool;
begin
//Włącza blokadę
SystemParametersInfo(97,Word(True),@OldValue,0);

//Wyłącza blokadę
SystemParametersInfo(97,Word(False),@OldValue,0);
end;


84. Jak dodać nazwę dokumentu do listy ostatnio otwartych dokumentów w menu Start?
lista dokumentów, recent
Trzeba skorzystać z funkcji Windows API o nazwie SHAddToRecentDocs:
uses ShlOBJ;

procedure TForm1.Button1Click(Sender: TObject);
var s:string;
begin
s:='C:\DownLoad\ntkfaq.html';
SHAddToRecentDocs(SHARD_PATH,PChar(s));
end;


85. Jak programowo włączyć lub wyłączyć monitor?
monitor, VESA
Należy wysłać komunikat wm_SysCommand z parametrem wParam ustawionym na
SC_MonitorPower zaś lParam ustawionym na:
0 - aby wyłączyć monitor
1 - aby go włączyć z powrotem
Wyłączenie monitora:
SendMessage(Application.Handle,wm_SysCommand,SC_MonitorPower,0);
Włączenie monitora:
SendMessage(Application.Handle,wm_SysCommand,SC_MonitorPower,-1);
Uśpienie maszyny:
SendMessage(Application.Handle,wm_SysCommand,SC_SCREENSAVE,-1);
Uwaga: Parametr SC_MonitorPower jest specyficzny dla Windows 95.
Uwaga: Comboy informuje, że pod WinME SC_MonitorPower też działa.
Źródło informacji: Michał Młynarczyk, Comboy.



86. Jak zmodyfikować menu systemowe formy?
menu systemowe, forma
Tak. Słyży do tego grupa funkcji: GetSystemMenu, AppendMenu, InsertMenu,
ModifyMenu. Przy tworzeniu formy dodajemy do menu systemowego własny element.
Jako jego identyfikator wybrałem liczbę zero zapisaną w stałej idTest.
const idTest=0;

procedure TMainForm.FormCreate(Sender: TObject);
var hMenu:THandle;
begin
hMenu:=GetSystemMenu(Handle,False);
AppendMenu(hMenu,mf_String,idTest,'&Test');
end;
Tak zdefiniowaną pozycję menu trzeba jeszcze samodzielnie obsłużyć. Robi to
procedura wywoływana gdy aplikacja dostanie komunikat wm_SysCommand:
procedure TMainForm.WMSysCommand(var Message:TWMSysCommand);
begin
if Message.CmdType=idTest then
begin
Message.Result:=0; //Zaznaczamy, że obsłużyliśmy komunikat
ShowMessage('Komunikat testowy');
end
else inherited;
end;



87. Jak odczytać wielkość wolnego obszaru na ekranie biorąc pod uwagę wysokość (szerokość) paska zadań?
pasek zadań, desktop, ekran, rozmiar
Należy skorzystać z funkcji SystemParametersInfo Windows API. Wywołana z
parametrem SPI_GETWORKAREA poda rozmiar wolnego miejsca na ekranie:
procedure CenterForm(AForm:TForm);
var R:TRect;
begin
SystemParametersInfo(SPI_GETWORKAREA,0,@R,0);
with AForm do
begin
Left := R.Left + (R.Right - R.Left - Width) div 2;
Top := R.Top + (R.Bottom - T.Top - Height) div 2;
end;
end;
Pozostaje już tylko wywołać ją dla odpowiedniej formy:
CenterForm(Form1)
Źródło informacji: Krzysztof Szyszka.



88. Jak otworzyć bazę Access'a (*.MDB) poprzez sterownik MSACCESS?
Access, BDE, sterownik
Otwieranie baz Accessa jest możliwe tylko dla Delphi 3.0 i powyżej, w wersji
Professional lub wyższej. Oprócz zainstalowanego BDE (najlepiej w wersji >=
4.51), na komputerze musi być zainstalowane DAO (jest w pakiecie Office 97, a
wersję do redystrybucji należy mieć z któregoś z produktów Microsoft'u)
Po instalacji BDE należy uruchomić BDE Administratora i w zakładce Configuration
znaleźć pozycję Configuration/Drivers/Native/MSACCESS. Tam trzeba przestawić
wartość pola DLL32 z IDDAO32.DLL na IDDA3532.DLL.
Aby skorzystać z bazy w formacie MDB wystarczy teraz utworzyć alias w
DatabaseDesktop lub utworzyć komponent TDatabase, a następnie ustawić wartości:
Database1.DriverName:='MSACCESS';
Database1.DatabaseName:='JakasNazwaDB';
Database1.Params.Clear;
Database1.Params.Add('DATABASE NAME=C:\Ścieżka_do\Pliku_bazy.mdb');
Database1.Connected:=True;
Dla każdego użytego TQuery lub TTable należy ustawić wartość DatabaseName taką
samą jak w Database1.DatabaseName.
Źródło informacji: Krzysztof Borys.



89. Jak programowo zmodyfikować ustawienia BDE sterownika MSACCESS i innych wartości BDE?
BDE, setup
Przy instalacji BDE domyślną wartością ustawień starownika MSACCESS jest
sterownik IDDAO32.DLL (DAO 3.0), który wykorzystywany był w starej wersji
Office, natomiast mając zainstalowany Office97 musimy zmienić ustawienia na
IDDA3532.DLL (patrz poprzednie pytanie). Aby zrobić to programowo można
skorzystać z poniższej procedury:
uses BDE;

procedure SetOffice97;
var Cursor:HDBICur;
ConfigDesc:CFGDesc;
begin
DBTables.Session.Active := true;
try
Check(DbiOpenCfgInfoList(nil,dbiREADWRITE,cfgPERSISTENT,
PChar('\DRIVERS\MSACCESS\INIT'),Cursor));
try
while DbiGetNextRecord(Cursor,dbiNOLOCK,@ConfigDesc,nil)=0 do
with ConfigDesc do
begin
OemToChar(szValue,szValue);
if (AnsiCompareText(szNodeName,'DLL32')=0) and
(AnsiCompareText(szValue,'IDDAO32.DLL')=0) then
begin
StrPCopy(szValue,'IDDA3532.DLL');
CharToOem(szValue,szValue);
Check(DbiModifyRecord(Cursor,@ConfigDesc,true));
Break;
end;
end;
finally
DbiCloseCursor(Cursor);
end;
finally
DBTables.Session.Active := true;
end;
end;
W przypadku używania w programie komponentów TSession należy zamienić odwołanie
z DBTables.Session na nazwę komponentu umieszczonego na formularzu
Źródło informacji: Krzysztof Borys.



90. Nie mogę stworzyć okienka MDIChild z ustawionym parametrem poDesigned.
MDIChild, MDI
Sprawdzane w Delphi 2.0.
Jeśli chcesz stworzyć okienko MDIChild o ściśle zadanej pozycji i ściśle
zadanych wymiarach, to z czegoś będziesz musiał zrezygnować. Delphi zawiera błąd
i wartość "poDesigned" wstawiona do pola "Position" formularza daje tyle samo co
"poDefault". Użyj "poDefaultPosOnly" i ustaw pozycję ręcznie lub
"poDefaultSizeOnly" i ręcznie ustaw rozmiar.
Źródło informacji: Maciej "MACiAS" Pilichowski.



91. Jak skopiować/skasować/przenieść cały katalog?
katalog, kopiowanie
Najwygodniej jest skorzystać z funkcji SHFileOperation znajdującej się w module
ShellAPI:
uses ShellAPI;

procedure TForm1.Button1Click(Sender: TObject);
var FOS:TSHFileOpStructA;
begin
with FOS do
begin
Wnd:=Handle;
wFunc:=FO_COPY;
pFrom:='c:\tip\źródło\*.*';
pTo:='c:\tip\cel\';
fFlags:=FOF_ALLOWUNDO or FOF_NOCONFIRMMKDIR;
lpszProgressTitle:='Kopiowanie...';
fAnyOperationsAborted:=False;
end;
if SHFileOperation(FOS)<>0 then
ShowMessage('Wystąpił błąd podczas kopiowania')
else
if FOS.fAnyOperationsAborted then
ShowMessage('Kopiowanie zostało przerwane');
end;

92. Jak programowo podłączyć dysk sieciowy?
sieć, dysk, podłączanie
Należy skorzystać z funkcji WNetAddConnection2:
procedure TForm1.Button3Click(Sender: TObject);
var Res:TNetResource;
begin
with Res do
begin
dwType:=RESOURCETYPE_ANY;
lpLocalName:='X:'; // podłącz jako dysk X
lpRioteName:='\\Komputer\Katalog'; // zdalny dysk
lpProvider:=Nil;
end;
if WNetAddConnection2(Res,'Hasło','Użytkownik',CONNECT_UPDATE_PROFILE)<>NO_ERROR then
ShowMessage('Błąd podczas podłączania dysku sieciowego');
end;



93. Nie mogę ustawić ikony dla okna MDI.
MDI, ikona, forma
Oto co pisze na ten temat MACiAS:
"Tworzę aplikację z wykorzystaniem MDI i wbrew temu, co jest napisane w helpie,
dla okienek MDIChild bez przypisanej ikony nie jest kopiowana ikona okna
głównego.
Tak się rzeczywiście dzieje, ale tylko dla okienek ze stylem ramki bsDialog.
Trudno mi powiedzieć, czyja to wina [pewnie Inprise'a :-) przyp. M.W.], ale
faktycznie help na ten temat milczy. Należy po prostu zrezygnować z tego stylu
ramki lub też "ręcznie" kopiować ikonę z okna głównego."
Źródło informacji: Maciej "MACiAS" Pilichowski.



94. Jak odczytać opis błędu funkcji API mając jego kod?
opis błędu, API
Należy skorzystać z funkcji Windows API o nazwie FormatMessage:
function GetErrorString(ErrorID:Integer):String;
var P:PChar;
begin
if FormatMessage(Format_Message_Allocate_Buffer+Format_Message_From_System,Nil,
ErrorId,0,@P,0,Nil)<>0 then
begin
Result:=P;
LocalFree(Integer(P));
end
else Result:=Format('Error in GetErrorString(%d) : %d',[ErrorID,GetLastError]);
end;

function GetLastErrorString:String;
begin
Result:=GetErrorString(GetLastError);
end;


95. Jak zmienić format wyświetlania i przechowywania dat dla bazy danych?
BDE, data, format
Należy uruchomić BDE Administratora i ustawić w konfiguracji odpowiedni
separator danych i żądany format (ustawia się go inaczej niż w Windows, więc
warto zerknąć do helpa).
W pliku naszego projektu (.dpr) w klauzuli uses należy dopisać deklarację użycia
modułu SysUtils i zaraz po instrukcji:
Application.Initialize;
należy dopisać:
Application.UpdateFormatSettings:=FALSE;
DateSeparator:=...
Short/Long DateFormat:=...
Źródło informacji: Adam Jastrząbek, Maciej "MACiAS" Pilichowski.



96. Jak zrobić "inteligentne" okno z atrybutem StayOnTop?
StayOnTop, zawsze na wierzchu
Czasem chcielibyśmy aby jedna z form była cały czas na wierzchu naszej formy
głównej nie przykrywając jednak okien innych aplikacji gdy się na nie
przełączymy. Jak to zrobić? Oto co pisze na ten temat Hopbit:
procedure TFrmTaskFilters.CreateParams( var cp : TCreateParams );
begin
inherited CreateParams( cp );
cp.Style := WS_POPUP or WS_BORDER or WS_SYSMENU or WS_CAPTION or
WS_MINIMIZEBOX or WS_SIZEBOX or WS_MAXIMIZEBOX;
cp.ExStyle := WS_EX_TOOLWINDOW;
cp.WndParent := Application.MainForm.Handle;
end;
"Wyjaśnienie:
Jeżeli okno(1) będzie parentem okna (2) i okno (2) będzie typu POPUP to okno (2)
będzie zawsze nad oknem (1). Kruczek jest w tym że to musi być parent w
rozumieniu Windows a nie Delphi.
Wadą tego rozwiązania jest to że dużą część parametrów okna trzeba ustawić
samemu, choć pewnie można by modyfikować cp tak aby nie niszczyć ustawień Object
Inspectora to mnie akurat tak było dużo wygodniej szczególnie że to było robione
na chybcika."
Źródło informacji: Krzysztof Świątkowski.


97. Jak zamknąć inną aplikację?
zamykanie aplikacji, API
Poniższą procedurę podał Rafał Płatek:
function KillProc(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 jej użyć należy podać nazwę klasy okna aplikacji np.:
KillProc('NOTEPAD');
Źródło informacji: podał Rafał Płatek.



98. Jak zablokować uruchamianie wygaszacza ekranu Windows?
wygaszacz ekranu, blokowanie
Aby zablokować uruchamianie wygaszacza należy skorzystać z funkcji WinAPI
SystemParametersInfo:
SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, Word(False), nil, 0);
Odblokowanie to:
SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, Word(True), nil, 0);
Źródło informacji: Dominik Jesiołowski.


99. Jak z Delphi 1.0 odwołać się do 32-bitowej biblioteki DLL?
thunk, DLL
Czasem zachodzi potrzeba (fakt, że ostatnio coraz rzadziej) odwołania się z
programu 16-bitowego do biblioteki 32-bitowej. Jest to możliwe chociaż
niezalecane prze Microsoft. Jak to zrobić opisał Błażej Filimonow:
"Aby coś niecoś poczytać, należy wziąć win32.hlp z pakietu Dalphi3. Znajduje się
w nim opis funkcji z 'KRNL386.EXE' :
LoadLibraryEx32W
FreeLibrary32W
GetProcAddress32W
Aby jednak znaleźć opis nie można korzystać z gotowego indeksu, bo jest
niepełny. Trzeba sobie włączyć tworzenie słownika, co przy rozmiarze helpa może
zając do 10 min. Później wyszukanie staje się banalnie proste. Problemem może
byś użycie niektórych typów, a właściwie ich brak w D1 np. DWORD. Kawałek kodu
który załatwia sprawę:
type TLoadLibraryEx32W=function(lpLibFileName:PChar;hFile:Pointer;
dwFlags:LongInt):Pointer;
TFreeLibrary32W=function(hInst:Pointer):Pointer;

var Kernel386Handle:THandle;
LoadLibraryEx32W:TLoadLibraryEx32W;
FreeLibrary32W:TFreeLibrary32W;
Handle_twojego_dll:Pointer;

begin
Kernel386Handle:=LoadLibrary('KRNL386.Exe');
@LoadLibraryEx32W:=GetProcAddress(Kernel386Handle,'LoadLibraryEx32W');
@FreeLibrary32W:=GetProcAddress(Kernel386Handle,'FreeLibrary32W');
Handle_twojego_dll:=LoadLibraryEx32W('twoj_dll',nil,0);
//Tu użycie twojego DLL'a}
FreeLibrary32W(Handle_twojego_dll);
FreeLibrary(Kernel386Handle);
end;
Uwaga 1:
W mojej wersji helpa D3 nie działają odnośniki ze stron do powyższych funkcji (
wszystko trzeba wyszukiwać se słownika)
Uwaga 2:
Opisy powyższych funkcji zostały usunięte z Win32.hlp w wersji D4. ciekawe czemu
???? Czyżby w kolejnej wersji były już zbędne ???????
Uwaga 3:
Należy pamiętac, że GetProcAddress32W i pochodne są Case Sensitive. Ja na tym
wpadłem i zmarnowałem godzinę czasu, zamnim zauważyłem, że mam jedną literę
małą, zamiast dużą w nazwie funkcji."
Źródło informacji: Błażej Filimonow.



100. Dlaczego dane wysłane poprzez TCP/IP przychodzą w częściach?
TCP/IP, internet
Protokół TCP/IP nie gwarantuje wielkości danych dostarczanych do odbiorcy. Jeśli
wyślemy 100KB danych mogą one dojść do miejsca przeznaczenia w 10-ciu kawałkach
po 10KB. Na pewno wiemy tylko, że dojdą w tej samej kolejności w jakiej były
wysłane.
Co zatem zrobić aby odebrać całość? Najlepiej wprowadzić własny protokół. Na
przykład wysyłać najpierw rozmiar pakietu (jako 4 bajtowy licznik typu Integer)
a potem właściwe dane. Odbiornik najpierw odczytuje 4 bajtowy rozmiar a potem
tak długo czeka na dane aż odbierze cały przekaz.


101. Jak przekazywać dane między procesami?
pamiec wspoldzielona, share, DLL, proces
"Podstawą jest zrozumienie, czym jest pamięć procesu. W przeciwieństwie do
środowiska Win31, gdzie programy (procesy) mogły hasać do woli po całej pamięci
komputera, w środowisku 32-bit proces jest ograniczony tylko do kawałka pamięci,
przydzielonej mu przez system. To oznacza, że ta sama wartość wskaźnika w dwu
różnych procesach de facto oznacza różne obszary pamięci! To jest właśnie
przyczyna, dla której początkujacy programiści tak często przekazuja do innego
procesu jako argument wskaźnik do pamięci głównego programu i dziwią się, że
program kładzie się z komunikatem Access Violation.
Najbardziej ogólnym rozwiązaniem jest polecenie systemowi, aby stworzył dla nas
pewien obszar pamięci, który będzie przechowywał nasze dane. Obszar ten jest
identyfikowany nazwą. Konkretny proces (główny program, DLL, procedura hooka,
etc.), który chce coś zapisać lub przeczytać z takiego obszaru, otwiera obszar,
tworzy widok tego obszaru i dopiero wtedy po nim pisze (czyta). Aktualizacja
danych następuje po zamknięciu widoku. Zwolnienie głównego obszaru pamięci
nastepuje oczywiście po wyraźnym sygnale ze strony programisty (wymagane także
jest rzecz jasna wcześniejsze zamknięcie widoków).
Oto prosty przykład (bardzo prosty i bez kontroli błędow!):
// zmienne występujace zarówno w procesie 1 i 2
var
uchwyt : THandle;
wskaznik : ^tu_nazwa_Twojej_struktury;

// 1 proces, nadrzędny

// utworzenie obszaru pamięci
uchwyt:=CreateFileMapping($FFFFFFFF,nil,Page_ReadWrite,0,
rozmiar_pamieci,'naprawde unikalna nazwa');

// dowolnie hasamy z widokami na wyżej utworzony obszar
wskaznik:=MapViewOfFile(uchwyt,File_Map_All_Access,0,0,0);
// tu Twój kod operujacy na pamięci
UnmapViewOfFile(wskaznik);



// 2 proces, podrzędny

// obszar pamieci jest tworzony przez proces nadrzędny, wiec ten proces
// tylko go otwiera
uchwyt:=OpenFileMapping(File_Map_Write,TRUE,'naprawde unikalna nazwa');

// dowolnie hasamy z widokami na wyżej utworzony obszar
wskaznik:=MapViewOfFile(uchwyt,File_Map_All_Access,0,0,0);
// tu Twoj kod operujacy na pamięci
UnmapViewOfFile(wskaznik);

// kończymy te zabawę z punktu widzenia procesu 2
CloseHandle(uchwyt);



// 1 proces, nadrzędny

// kończymy tę zabawę definitywnie
CloseHandle(uchwyt);
Wiecej informacji znajdziecie w helpie do powyżej użytych funkcji.
Jeśli chcemy przekazać coś na szybko z procesu do programu głównego, który
posiada okno, możemy wysłać komunikat WM_COPYDATA. Przykładowo:
var
copydata : TCopyDataStruct;
s : string;
begin
s:='przyklad wysylania komunikatu WM_COPYDATA';
copydata.cbData:=length(s);
copydata.lpData:=@s[1];
SendMessage(uchwyt_docelowego_okna,WM_COPYDATA,0,longint(@copydata));
I już naprawdę na koniec: o ile w Win31 można było przyjąć, iż program był
tożsamy procesowi, tak w 32-bit jest to juz błędem. Proces jest wydzielonym
kodem z własną pamięcią "operacyjną" - wyznacznikiem nie jest ani jego miejsce w
naszym źrodle, ani powiązania, ani nasze pobożne życzenia. Najlepszym przykładem
są funkcje hooka - funkcja ta jest transponowana do pamięci procesu adresata.
Tj. jeśli napisaliśmy hooka systemowego, to system stworzy tyle jego bliźniakow,
ilu może byc adresatów. Ma to swoje minusy (ból glowy programisty), ale też jest
np. w miarę wygodnym mechanizmem wstrzykiwania własnej pamięci do zewnętrznych
procesów (ale to już inna bajka)."
Źródło informacji: Maciej "MACiAS" Pilichowski.



102. W jaki sposób mogę śledzić przesyłane w systemie komunikaty?
hook, message, filtr, wiadomość
"Na drodze między nadawcą komunikatu, a jego odbiorcą, twórcy Windows umożliwili
zaistnienie różnego rodzaju filtrów, do których dochodzi wiadomość i w
zależności od decyzji takiego filtru, jest ona przekazywana dalej bądz też nie.
Oczywiscie filtr powinien elegancko koegzystowac z innymi, wcześniej
zainstalowanymi filtrami. W tym celu Twoj filtr nie powinien bezpośrednio
oddawać kontroli systemowi, ale wywoływać następny w kolejce filtr.
Piszac filtr pamiętaj, iż system przy każdej przesyłce komunikatu, będzie
"wstrzykiwał" kod Twojego filtru do pamięci procesu adresata. Jeśli adresatów
będzie wielu, Twoj filtr zostanie zduplikowany wiele, wiele razy. Jakie ma to
konsekwencje? Nie możesz polegać na żadnych danych, które zadeklerowałeś na
zewnątrz treści funkcji filtrującej w kodzie źrodłowym Twojego DLLa (filtr,
który śledzi cały system musi znajdować się wewnątrz DLLa). Co wiecej - zmienne
inicjowane wewnątrz Twojej funkcji zmieniają swoje tradycyjne znaczenie. Nie
przechowują bowiem już wartości z poprzedniego wywołania tej funkcji, lecz
przechowują poprzednią wartość z wywołania danej instancji funkcji (innymi słowy
-- każdy duplikat Twojej funkcji, będzie posiadał własne wartości zmiennych
inicjowanych).
Powyższe wiadomości powinny wystarczyć Ci do napisania własnego hooka (filtru).
Poniżej znajduje się podstawowy schemat instalacji hooka - więcej informacji nt.
argumentów i wywołań odnośnych funkcji znajdziesz w helpie:"
// nazwę mapy pamięci najlepiej przypisać stałej
const
MySharedDataMapName = 'MojaNaPewnoUnikalnaNazwaMapyPamieci ;-)';

// jeśli w funkcji hooka będziecie operować jedynie uchwytem
// następnego filtru, to nie ma potrzeby pakowania tego do rekordu
type
TSharedData = record
NextHookHandle : HHook;
end;

// nagłówek hooka będzie zawsze wyglądał jak poniżej, argument code
// jest bardzo ważny, więc na pewno zerknijcie do helpa
// znaczenie wParam i lParam zależy od typu filtra
function MyHookProc(code : longint;
wParam : longint;
lParam : longint) : longint; export; stdcall;
var
// uchwyt do mapy pamięci i wskaźnik do widoku mapy
SharedDataHandle : THandle;
SharedDataPtr : ^TSharedData;
begin
// otwieramy mapę i tworzymy jej widok
SharedDataHandle:=OpenFileMapping(File_Map_Write,TRUE,MySharedDataMapName);
SharedDataPtr:=MapViewOfFile(SharedDataHandle,File_Map_All_Access,0,0,0);

// tutaj następuje Wasz kod
...
// koniec Waszej części

// wywołanie następnego hooka w łańcuchu filtrów
CallNextHookEx(SharedDataPtr^.NextHookHandle,code,wParam,lParam);

// kasujemy widok i zamykamy mapę
UnmapViewOfFile(SharedDataPtr)
CloseHandle(SharedDataHandle);

result:=0; // przepuść meldunek
end;

var
SharedDataHandle : THandle;
SharedDataPtr : ^TSharedData;

procedure InstallFilter(LibHandle : THandle); export;
begin
SharedDataHandle:=CreateFileMapping($FFFFFFFF,nil,Page_ReadWrite,0,
sizeof(TSharedData),MySharedDataMapName);
SharedDataPtr:=MapViewOfFile(SharedDataHandle,File_Map_All_Access,0,0,0);
// drugi argument to oczywiście adres w DLLu naszej funkcji filtru
// czwarty argument to uchwyt okna, które chcemy śledzić, 0 oznacza
// wszystko co tylko znajduje się w systemie -- czyli hook systemowy
SharedDataPtr^.NextHookHandle:=SetWindowsHookEx(WH_GETMESSAGE,
GetProcAddress(LibHandle,'MyHookProc'),LibHandle,0);
end;

procedure RemoveFilter; export;
begin
UnHookWindowsHookEx(SharedDataPtr^.NextHookHandle);
UnmapViewOfFile(SharedDataPtr)
CloseHandle(SharedDataHandle);
end;
Żródło informacji: Maciej "MACiAS" Pilichowski.


103. Jak znaleźć wszystkie pliki w katalogu i jego podkatalogach?
katalogi
Można użyć poniższej procedury:
procedure PenetrateDirectory(dir: String; list: TStrings; mask: String);
var
SRec: TSearchRec;
res: Integer;
ec: Char;
begin
ec := ':';
if dir <> '' then ec := dir[Length(dir)];
if (ec <> '\') and (ec <> ':') then dir := dir + '\';
// dodanie '\' na koncu nazwy katalogu

res := FindFirst(dir + mask, faArchive, SRec);
while res = 0 do begin
list.Add(dir + SRec.Name);
res := FindNext(SRec);
end;
FindClose(SRec);
// petla "zbierajaca" pliki

res := FindFirst(dir + '*', faDirectory, SRec);
while res = 0 do begin
if (SRec.Attr and faDirectory <> 0)
and (SRec.Name <> '.' ) and (SRec.Name <> '..') then
PenetrateDirectory(dir + srec.Name, list, mask);
res := FindNext(SRec);
end;
FindClose(SRec);
// przeszukiwanie wglab
end;
Źródło informacji: Milosz Krajewski.



104. Jak zidentyfikować komputer korzystając z numeru MAC karty sieciowej?
karta sieciowa, MAC
Można skorzystać z poniższego kodu:
Uses NB30;

Type
TNBLanaResources = (lrAlloc, lrFree);
PMACAddress = ^TMACAddress;
TMACAddress = Array [0..5] Of Byte;

{Odczytuje liczbę kart sieciowych w komputerze}

Function GetLanaEnum(LanaEnum: PLanaEnum): Byte;
Var
LanaEnumNCB: PNCB;
Begin
New(LanaEnumNCB);
ZeroMemory(LanaEnumNCB, SizeOf(TNCB));
Try
With LanaEnumNCB^ Do
Begin
ncb_buffer := PChar(LanaEnum);
ncb_length := SizeOf(TLanaEnum);
ncb_command := Char(NCBENUM);
NetBios(LanaEnumNCB);
Result := Byte(ncb_cmd_cplt);
End;
Finally
Dispose(LanaEnumNCB);
End;
End;

{Odczytuje nr fizyczny karty sieciowej}
Function GetMACAddress(LanaNum: Byte; MACAddress: PMACAddress): Byte;
Var
AdapterStatus: PAdapterStatus;
StatNCB: PNCB;
Begin
New(StatNCB);
ZeroMemory(StatNCB, SizeOf(TNCB));
StatNCB.ncb_length := SizeOf(TAdapterStatus) + 255 * SizeOf(TNameBuffer);
GetMem(AdapterStatus, StatNCB.ncb_length);
try
with StatNCB^ do
begin
ZeroMemory(MACAddress, SizeOf(TMACAddress));
ncb_buffer := PChar(AdapterStatus);
ncb_callname := '* ' + #0;
ncb_lana_num := Char(LanaNum);
ncb_command := Char(NCBASTAT);
NetBios(StatNCB);
Result := Byte(ncb_cmd_cplt);
if Result = NRC_GOODRET then
MoveMemory(MACAddress, AdapterStatus, SizeOf(TMACAddress));
end;
finally
FreeMem(AdapterStatus);
Dispose(StatNCB);
end;
End;

{"Tłumaczy" numer na postać strawną dla postronnych}

Function MACAddr : String;
var
LanaNum: Byte;
MACAddress: PMACAddress;
RetCode: Byte;
begin
LanaNum := 0;
New(MACAddress);
try
RetCode := GetMACAddress(LanaNum, MACAddress);
If RetCode = NRC_GOODRET then
Begin
Result := Format('%2.2x-%2.2x-%2.2x-%2.2x-%2.2x-%2.2x',
[MACAddress[0], MACAddress[1], MACAddress[2],
MACAddress[3], MACAddress[4], MACAddress[5]]);
end
else
begin
Beep;
Result := 'Error';
ShowMessage('GetMACAddress Error! RetCode = $' + IntToHex(RetCode,2));
End;
finally
Dispose(MACAddress);
End;
End;
Źródło informacji: Paweł Trzciński.


105. Jak wykryć moment wstawienia czegoś do schowka?
schowek
Należy w sekcji uses dopisać moduł Clipbrd:
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ClipBrd;
W formie dopisać deklaracje trzech procedur i zmiennej:
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
// zmienna i trzy procedury dla kontroli schowka
FClipboardOwner: HWnd;
procedure ClipboardChanged;
procedure WMChangeCBChain(var Msg: TWMChangeCBChain); message WM_CHANGECBCHAIN;
procedure WMDrawClipboard(var Msg: TWMDrawClipboard); message WM_DRAWCLIPBOARD;
w procedurze zdarzenia FormCreate dopisać:
FClipboardOwner := SetClipboardViewer(Handle);
w procedurze zdarzenia FormDestroy dopisać:
ChangeClipboardChain(Handle, FClipboardOwner);
Napisać poniższe procedury:
procedure TForm1.WMChangeCBChain(var Msg: TWMChangeCBChain);
begin
if Msg.Remove = FClipboardOwner then FClipboardOwner := Msg.Next
else SendMessage(FClipboardOwner, WM_CHANGECBCHAIN, Msg.Remove, Msg.Next);
Msg.Result := 0;
end;

procedure TForm1.ClipboardChanged;
var
Format: Word;
begin
{
tu wpisac co ma sie dziac po wstawieniu czegos do schowka
np. sprawdzenie formatu schowka i wywolanie pozadanego
przez nas zdarzenia. Dla testu niech bedzie to zwykle 'beep' :-)
}

beep;
end;

procedure TForm1.WMDrawClipboard(var Msg: TWMDrawClipboard);
begin
SendMessage(FClipboardOwner, WM_DRAWCLIPBOARD, 0, 0);
Msg.Result := 0;
ClipboardChanged;
end;
Źródło informacji: Dafi.



106. Jak zamknąć system?
zamykanie, Windows, API
Należy użyć funkcji API:
ExitWindowsEx(EWX_SHUTDOWN,0)- zamknięcie systemu
ExitWindowsEx(EWX_REBOOT,0) - reset
ExitWindowsEx(EWX_LOGOFF,0)- wylogowanie
W tej formie funkcje zadziałają pod Windows 9x. Dla Windows NT należy je
zmodyfikować tak aby podawały systemowy prawa użytkownika. Nie każdy użytkownik
ma bowiem prawo zamykać system w NT. Oto jak to zrobić:
function DelphiExitWindows( Flags : Word):Boolean;
var
iVersionInfo: TOSVersionInfo;
iToken : THandle;
iPriveleg : TTokenPrivileges;
iaresult : Integer;
begin

Result:=FALSE;
FillChar (iPriveleg, SizeOf (iPriveleg), #0);
iVersionInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
GetVersionEx(iVersionInfo);
if iVersionInfo.dwPlatformId <> VER_PLATFORM_WIN32_NT then
Result:=ExitWindowsEx (Flags, 0)
else
if OpenProcessToken (GetCurrentProcess,
TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, iToken) then
if LookupPrivilegeValue (NIL,'SeShutdownPrivilege',
iPriveleg.Privileges[0].Luid) then
begin
iPriveleg.PrivilegeCount := 1;
iPriveleg.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
if AdjustTokenPrivileges (iToken,False,iPriveleg,
Sizeof(iPriveleg),iPriveleg,iaresult) then
Result:=ExitWindowsEx (Flags, 0);
end;
end;
Przykład wywołania:
DelphiExitWindows( EWX_REBOOT or EWX_FORCE );
Źródło informacji: Paweł Księżyk.



107. Jak obsłużyć upuszczanie plików na formę? Drag&Drop
Należy skorzystać z komunikatu wm_DropFiles. Ma to tą zaletę, że zadziała nawet
w Delphi 1.
uses
ShellAPI; {obsługa D&D}

....

procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnMessage := AppMessage;
DragAcceptFiles (Handle, True);
end; {mówimy systemowi że chcemy obsłużyć D&D}

procedure TForm1.WMDropFiles (hDrop : THandle; hWindow : HWnd);
Var
TotalNumberOfFiles,
nFileLength : Integer;
pszFileName : PChar;
i : Integer;

Begin
//liczba zrzuconych plików
TotalNumberOfFiles := DragQueryFile (hDrop , $FFFFFFFF, Nil, 0);

for i := 0 to TotalNumberOfFiles - 1 do begin
nFileLength := DragQueryFile (hDrop, i , Nil, 0) + 1;
GetMem (pszFileName, nFileLength);
DragQueryFile (hDrop , i, pszFileName, nFileLength);

//pszFileName - nazwa upuszczonego pliku
//tutaj robimy coś z nazwą pliku

FreeMem (pszFileName, nFileLength);
end;

DragFinish (hDrop);
end; //sprawdzamy co zostało przeciągnięte i obsługujemy to

procedure TForm1.AppMessage(var Msg: TMsg; var Handled: Boolean);
begin
case Msg.Message of
WM_DROPFILES : WMDropFiles (Msg.wParam, Msg.hWnd);
end;
end; //obsługujemy komunikat WM_DROPFILES

procedure TForm1.FormClose (Sender: TObject; var Action: TCloseAction);
begin
DragAcceptFiles (Handle, False);
end; //dziękujemy
Źródło informacji: Artur Prokopiuk.


108. Jak wywołać standardowe okno podłączania dysku sieciowego?
sieć, udziały
Należy użyć kodu:
WNetConnectionDialog(Application.Handle, RESOURCETYPE_DISK);
Poniższa procedura pokazuje okno odłączenia dysku:
WNetDisconnectDialog(Application.Handle, RESOURCETYPE_DISK);
Zaś zamiana stałej RESOURCETYPE_DISK na RESOURCETYPE_PRINT pokaże okno
podłączenia drukarki sieciowej.
Źródło informacji: Konrad Pawlus.


109. Jak wydobyć systemową ikonę pliku?
Należy skorzystać z funkcji SHGetFileInfo. Wygodnie będzie użyć również klasy
TImageList. W pierwszym kroku deklarujemy listy ikon:
var SmallImages, LargeImages: TImageList;
Następnie tworzymy je i wypełniamy ikonami:
uses ShellAPI; {w sekcji uses należy dodać plik ShellAPI.pas}
procedure TMainForm.CreateImages;
var sfi: TSHFileInfo;
begin
if not Assigned(SmallImages) then
begin
SmallImages := TImageList.Create(Self);
SmallImages.Handle := SHGetFileInfo('nazwapliku', 0, sfi, SizeOf(TSHFileInfo),
SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
SmallImages.ShareImages := TRUE;
end;
if not Assigned(LargeImages) then
begin
Largeimages := TImageList.Create(self);
LargeImages.Handle := SHGetFileInfo('nazwapliku', 0, sfi, SizeOf(TSHFileInfo),
SHGFI_SYSICONINDEX or SHGFI_LARGEICON);
LargeImages.ShareImages := TRUE;
end;
end;
Teraz możemy już z nich korzystać. Na przykład wypełniając TListView nazwami
plików i ich ikonami. Lista musi mieć trzy kolumny (Caption, SubItems[1],
SubItems[2]). Należy też poinformować ją skąd ma czerpać ikony:
Lista.SmallImages := SmallImages;
Lista.LargeImages := LargeImages;
Teraz wystarczy dodać do listy plik przy pomocy procedury:
procedure TMainForm.DodajDoListy(Lista: TListView; Plik: String);
var NowyPlik: TListItem;
Sfi: TSHFileInfo;
Typ: String;
begin
SHGetFileInfo(PChar(Plik), 0, Sfi, SizeOf(sfi),
SHGFI_TYPENAME or SHGFI_SYSICONINDEX or SHGFI_DISPLAYNAME)
NowyPlik := Lista.Items.Add;
NowyPlik.Caption := ExtractFileName(Plik);
NowyPlik.ImageIndex := Sfi.iIcon;
NowyPlik.SubItems.Add(Sfi.szTypeName);
NowyPlik.SubItems.Add(Typ);
end;
Źródło informacji: Konrad Pawlus.


110. Nie działa TQuery.Refresh. Co robić?
SQL, TQuery, Refresh
Zamiast Refresh można użyć konstrukcji:
Close;Open;
Źródło informacji: Piotr Neil Gawronski.



111. Mam problemy z drukowaniem bitmap. Co robić?
drukowanie, bitmapa
Na niektórych drukarkach występują problemy z drukowaniem bitmap. Powinna pomóc
poniższa procedura:
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 D1}
try
Image := AllocMem(ImageSize); {<-- MemAlloc dla D1}
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;
Źródło informacji: Marcin BACIK Koteras.



112. Jak zapisać poprawnie datę w SQL?
lokalny SQL, format daty
W lkalnym SQL format daty jest niezmienny i niezależny od ustawień systemowych.
Należy datę zapisywać w postaci: "MM/DD/YY(YY)". Jeśli datę wpisujemy w runtime
pomocna może być konstrukcja:
DataDlaSQLa:=''''+FormatDateTime('mm"/"dd"/"yyyy',d)+'''';
Źródło informacji: Maciej "MACiAS" Pilichowski.



113. W jaki sposób zasymulować kliknięcie myszy lub klawiatury, ale w taki sposób, żeby było wykrywalne przez inne programy?
mysz, klawiatura
Do symulacji kliknięć myszą służy funkcja WinAPI mouse_event:
mouse_event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTDOWN, x, y, 0, 0);
mouse_event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTUP, x, y, 0, 0);
co daje symulację kliknięcia lewym przyciskiem myszy w punkcie (x,y), natomiast
do symulacji klawiatury używamy funkcji keybd_event
keybd_event(VK_UP, 0, 0, 0);
keybd_event(VK_UP, 0, KEYEVENTF_KEYUP, 0);
Co powoduje symulację kliknięcia klawisza strzałki w górę.
Źródło informacji: Krzysztof Borys (Bask).



114. Jak spakować bazę danych MS Access?
baza danych, Access
Na to pytanie odpowiada Tomek Cwajda: "Należy skorzystać z obiektu TJetEngine
jaki udostępnia biblioteka Microsoftu JRO (Jet and Replication Objects) będąca
składnikiem pakietu MDAC (Microsoft Data Access Components). Jak dotąd
najświerzszą wersją MDAC jest wersja 2.5 a jeżeli chodzi o JRO to jest to wersja
2.1. Aby skorzystać z wyżej wymienionej biblioteki należy "importować bibliotekę
typów". po uruchomieniu komendy z menu "Project | Import Type Library"
wskazujemy bibliotekę "Microsoft Jet and Replication Objects 2.1 Library
(Version2.1)". Jeżeli tej biblioteki nie ma na liście a jesteśmy pewni, że mamy
zainstalowane MDAC, to należy dodać je do listy wskazując plik "msjro.dll",
który z regóły jest umiejscowiony w katalogu "C:\Program Files\Common
Files\System\ado\". Po zainstalowaniu możemy powstały moduł uwzględniać w
projekcie. Standardowa nazwa nadawana przez wizzard'a to JRO_TLB.
unit Unit1;

interface

uses
...,
JRO_TLB ;

type
...

implementation
...

procedure CompressRepair;
var MyJetEngine:TJetEngine;
strSourceConnection,strDestConnection,strJetType:WideString;
begin
//Dla Access 2000 Engine Type =5
strJetType:='Jet OLEDB:Engine Type=4';
strSourceConnection:='Data Source=D:\Program Files\'+
'Borland Shared\Data\dbdemos.mdb;';
strDestConnection:='Data Source=D:\Program Files\'+
'Borland Shared\Data\dbdemos_compacted.mdb;'+strJetType;
MyJetEngine:=TJetEngine.Create(nil);
try
MyJetEngine.CompactDatabase(strSourceConnection,strDestConnection);
finally
MyJetEngine.Free;
end;
end;

end.
Mogę dodać, że procedura ta powinna również realizować naprawianie bazy, jednak
nie przetestowałem tego."
Źródło informacji: Tomek Cwajda.


115. Jak uzyskać posortowane drzewo katalogów?
drzewo katalogów, dysk
Na to pytanie odpowiada Przemysław Walasek:
"Oczywiście istnieją (jak zawsze) dwie metody: falenicka i otwocka. Różnią się
one tylko w sposobie uzyskania struktury posortowanego drzewka. Podstawowym
błędem jest używanie metody AlphaSort kontrolki TreeView.
1. Metoda falenicka.
procedure ListujKatalogi(tnRodzic : TTreeNode; strSciezka : string);
//Metoda falenicka
var
sr : TSearchRec;
iWynik : integer;
tnDziecko : TTreeNode;
begin
iWynik := FindFirst(strSciezka + '*.*', faAnyFile, sr);
//czytamy pierwszy plik_katalog
while iWynik = 0 do{odkiedy cos jest znajdywane}
begin
if ((sr.Attr and faDirectory) = faDirectory) and
(sr.Name <> '.')and(sr.Name <> '..') then
//jezeli jest to katalog
begin{dopisujemy do drzewka}
tnDziecko := frm.trv.Items.AddChild(tnRodzic, sr.Name);
//dopisujemy katalog jako podrzedny
Licznik := Licznik + 1;
frm.Caption := 'Znalazlem : ' + IntToStr(Licznik) + '
katalog(ów).';
ListujKatalogi(tnDziecko ,strSciezka + sr.Name + '\');
//wywolujemy rekeurncyjnie metode, jako kat. nadrzedny bedzie teraz ostatnio znaleziony kat.
end;
iWynik := FindNext(sr);
//szukamy nastepnych
end;
FindClose(sr);
//zwalniamy pamiec
if tnRodzic = Nil then
else
tnRodzic.AlphaSort;
//i tu jest caly widz metody falenickiej!
//ta linia wykona sie wtedy gdy kat. symbolizowany przez tnRodzic
//ma juz znane wszystkie swoje podkatalogi, i tu nalezy wywolac
//ALphaSort, ale NIE DLA TREEVIEW ale dla TREENODE tnRodzica!
//roznica polega na tym ze AplhaSort TreeView sortuje cala zawartosc
//a tn.AlphaSort Sortuje TYLKO swoje dzieci, efekt widac...
//I co panie Lodku jest <30 lini kodu ;-)
end;

//procedura uruchamiajaca reakcje lancuchowa
procedure Tfrm.btnClick(Sender: TObject);
var
i : byte;
cDysk : Char;
tdtStart, tdtKoniec : TDateTime;
begin
trv.Items.Clear;
//czyscimy drzekw
tdtStart := Now;// *
frm.trv.Items.BeginUpdate;
for cDysk := 'C' to 'G' do
begin
ListujKatalogi(trv.Items.AddChild(nil, '(Dysk ' + cDysk + ':)'),
cDysk + ':\');
//ako pierwsze wywolanie przekazujemu NIL, co oznacza ze pierwszym
//tnRodzicem jest TreeView
end;
frm.trv.Items.EndUpdate;
tdtKoniec := Now;{*}
tdtKoniec := tdtKoniec - tdtStart; // *
btn.Caption := 'Czas listowania: ' + DateTimeToStr(tdtKoniec); // *
//oczywiscie nie bede tu pisal jak rozpoznac ktora litera to dyk itd
//bo to jest w FAQ grupy
end;
2. Metoda otwocka. Opiera się na zgoła innym założeniu, mianowicie sortowaniu
ulega tylko ta ilość Node-ów, która jest niezbędna. Jak to uzyskać najprościej?
Ano w obsłudze zdarzenia kontrolki TreeView - Expanding (nie Expanded), które
towarzyszy rozwijaniu node-ow. Procedury tej nie powinno się umieszczać w
zdażeniach OnClick lub DblClick, bo rozwijanie jest możliwe z poziomu kodu, co
nie spowoduje wykonania w/w zdarzeń.
procedure ListujKatalogi(tnRodzic : TTreeNode; strSciezka : string);
//Metoda otwocka
var
sr : TSearchRec;
iWynik : integer;
tnDziecko : TTreeNode;
begin
iWynik := FindFirst(strSciezka + '*.*', faAnyFile, sr);
//czytamy pierwszy plik_katalog
while iWynik = 0 do//jezeli znalazl cos
begin
if ((sr.Attr and faDirectory) = faDirectory) and
(sr.Name <> '.')and(sr.Name <> '..') then
begin{dopisujemy do drzewka}
tnDziecko := frm.trv.Items.AddChild(tnRodzic, sr.Name);
Licznik := Licznik + 1;
frm.Caption := 'Znalazlem : ' + IntToStr(Licznik) + '
katalog(ów).';
ListujKatalogi(tnDziecko ,strSciezka + sr.Name + '\');
end;
iWynik := FindNext(sr);
end;
FindClose(sr);
end;

procedure Tfrm.trvExpanding(Sender: TObject; Node: TTreeNode;
var AllowExpansion: Boolean);
//Metoda otwocka
begin
trv.Items.BeginUpdate;
while Node <> nil do
//sprawdzamy czy istnieja jakies dzieci Node-a wywolujacego zdarzenie
begin
Node.AlphaSort;//jezeli tak, to sortujemy
Node := Node.GetNextSibling;//i pobieramy nastepnego w szeregu
end;
trv.Items.EndUpdate;
end;
Widać, że nie ma różnicy przy ładowanu drzewka, czasy ładowania z sortowaniem i
bez są porównywalne, więc metoda falenicka wydaje sie być atrakcyjniejsza, gdyż
zwalnia nas od obsługi Expanding. Można oczywiście posortować samemu, podczas
stanu jałowego aplikacji, można bezproblemowo dodać do tej listy pliki itd...
Można oczywiście ładowac katalogi bezpośrednio z dysku w odpowiedni sposób na
żądanie rozwinięcia, napisałem kiedyś taki właśnie sposób, mogę go sprobować
odnaleźć. Jego zaletą jest to, iż pozwala na wyświetlanie aktualnego stanu
katalogów. Wyżej podane sposoby ładują drzewo, ale są niewrażliwe na zmiany na
dysku. Ale rozwiązanie też nie jest trudne. O późno się zrobiło, czas kończyć."
Źródło informacji: Przemysław Walasek.



116. Jak dodać ikonę programu do Tray'a. ( ikonka obok zegara Windows ).
Oto kod. Aha, dodaj do listy modułów słowo "ShellAPI".
1. Do sekcji private dodaj takie pozycje:
IconNotifyData : TNotifyIconData;
procedure WndProc(var Msg : TMessage); override;
2. Teraz w OnCreate wpisz taki oto kod:
with IconNotifyData do
begin
hIcon:=Application.Icon.Handle;
uCallbackMessage:=WM_USER+1;
cbSize:=SizeOf(IconNotifyData);
Wnd:=Handle;
uID:=100;
uFlags:=NIF_MESSAGE+NIF_ICON+NIF_TIP;
end;
// Kopiujemy tytuł aplikacji jako "dymek"
StrPCopy(IconNotifyData.szTip, Application.Title);

// Dodajemy ikonę do traya
Shell_NotifyIcon(NIM_ADD,@IconNotifyData);
Następnie uzupełnij procedure "WndProc" w taki oto sposób:
procedure TMainFrm.WndProc(var Msg : TMessage);
var
p : TPoint;
begin
{
Ta procedura służy do przechwytywania komunikatów po naciśnięciu
przycisku w obrębie ikony.
}
//Jezeli nacisnieto prawym przyciskiem myszy
if (Msg.Msg=WM_USER+1) and (Msg.lParam = WM_RBUTTONDOWN) then
begin
//Nastepuje pobranie pozycji kursora myszki
GetCursorPos(p);
//i wyswietlenie menu
TrayMenu.Popup(p.x, p.y);
end;
//Jezeli nacisnieto lewy przycisk nastepuje wyswietlenie //formy
if Msg.LParam = WM_LBUTTONDOWN then
MainFrm.Show;

inherited;
end;
Dodatkowo przy zamykaniu programu możesz dopisać linie:

Shell_NotifyIcon(NIM_DELETE, @IconNotifyData);
Usuwa ona ikone z Tray'a.


117. Jak sprawdzić jaki typ danych jest w schowku?
Należy skorzystać z modułu Clipbrd; Następnie możesz sprawdzić, czy w
schowku jest tekst, bitmapa itp:
var
B : Tbitmap;
begin
try
try
if Clipboard.HasFormat(CF_TEXT) then
ShowMessage(
ClipBoard.AsText);
if Clipboard.HasFormat(CF_BITMAP) then
B := Tbitmap.Create;
B.Assign(ClipBoard);
B.Width := 120;
B.Height := 100;
finally
B.Free;
end;
except
raise Exception.Create(
'Ne ma nic w schowku!');
end;
CF_TEXT - tekst.
CF_BITMAP - bitmapa Windows;
CF_PICTURE - zdjęcie klasy TPicture.
CF_METAFILEPICT - metaplik;



118. 7. Jak zrobić, aby w ListBox każda czcionka była w osobnym kroju ( tak jak w Wordzie 2000) ?
Jeżeli ktoś ma Worda 2000 to zauważył pewnie, że po rozwinięciu listy
czcionek każda napisana jest osobną czcionką :) Jak to zrobić na
przykładzie ListBox'a.
W on Create:
Screen.Fonts := ListBox.Items;
W DrawItem list box'a:
with ListBox1.Canvas do
begin
FillRect(Rect);
Font.Name := ListBox1.Items[Index];
Font.Size := 0;
TextOut(Rect.Left, Rect.Top, ListBox1.Items[Index]);
end;
W MeasureItem list box'a:
with ListBox1.Canvas do
begin
Font.Name := Listbox1.Items[Index];
Font.Size := 0;
Height := TextHeight('!!') ;
end;

Teraz w Inspektorze Obiektów musisz zmienić właściwość "Style"
komponentu "ListBox" na "lbOwnerDrawVariable".


119. Jak pobrać ikonę dowolnego programu?
Słuzy do tego funkcja "ExrtactIcon". Ikona programu przechowywana jest
pod postacią zmiennej typu HIcon.
var
H : HIcon;
begin
H := ExtractIcon(Handle,
'Nazwa Programu.exe', 0);
Image.Picture.Icon.Assign(H);


120. Jak rysować po pulpicie?
Po pulpicie można rysować jak w zwykłym Canvasie. Wystarczy tylko pobrać
uchwyt pulpitu:
Canvas.Handle:=GetWindowDC(GetDesktopWindow);
//tutaj używamy funkcji Canvas'a do rysowania

// rysujemy np. kwadrat
Canvas.Rectangle(20, 20, 220, 220);



121. Jak odczytać numer kolumny i wiersza w RichEdit?
Do listy modułów "uses" dodaj słowo "RichEdit". Teraz możesz stworzyć
swoją procedurę: GetCursorPosition i w taki sposób uzupełnić tę
procedurę:
procedure TChild.GetCursorPosition;
var
Pos: TPoint;
begin
Pos.Y := SendMessage(RichEdit.Handle, EM_EXLINEFROMCHAR, 0,
RichEdit.SelStart);
Pos.X := (RichEdit.SelStart - SendMessage(RichEdit.Handle,
EM_LINEINDEX, Pos.Y, 0));

Inc(Pos.X);
Inc(Pos.Y);
ShowMessage(Format(
'Lnia: %d; Znak: %d', [P.X, P.Y]));
end;


122. Jak uzyskać systemowe ikonki?
Można np. w Image umieścić standardowe ikonki Windows. Oto jak tego
dokonać:
Image1.Picture.Icon.Handle := LoadIcon(0, IDI_APPLICATION);
Istnieje możliwość zastosowania także tych ikonek:
IDI_ASTERISK
IDI_EXCLAMATION
IDI_HAND
IDI_QUESTION
IDI_WINLOGO


123. Nie działa "StayOnTop". Co robić?
Czasami "fsStayOnTop" nie działa. W takim wypadku możesz zrobić coś
takiego:
SetWindowPos(Handle, HWND_TOPMOST, Left, Top, Width, Height, 0);



124. Jak znaleźć tekst w RichEdit?
Oto kod:
var
FoundAt: LongInt;
StartPos, ToEnd: Integer;
begin
with RichEdit do
begin
if SelLength <> 0 then
StartPos := SelStart + SelLength
else
StartPos := 0;

ToEnd := Length(Text) - StartPos;

FoundAt := FindText(
'Tekst', StartPos, ToEnd, [stMatchCase]);
if FoundAt <> -1 then
begin
SetFocus;
SelStart := FoundAt;
SelLength := Length('Tekst');
end;
end;
end;


125. Jak ustawić wygaszacz ekranu na brak?

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

Teraz jeżeli chcesz przywrócić domyślne ustawienia:

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



126. Jak wyświetlić ikonę skojarzoną z danym rozszerzeniem?

uses ShellAPi;
var
Ico : PShFileInfo;
begin
GetMem( Ico, sizeof(TShFileInfo) );
try
shGetFileInfo( PChar('sciezka_i_nazwa_pliku'), 0, Icoi^,
sizeof(TShFileInfo), shgfi_sysiconindex or shgfi_icon or
shgfi_smallicon);
Image1.Picture.Icon.Handle:=Ico.hIcon;
finally
FreeMem(sfi);
end;
end;


127. Jak wyłączyć skróty w Windows? ( Ctrl + Del + Alt ).
Na samym początku ostrzeżenie: poniższy kod nie działa na Windows NT.
Należy oszukać system tak aby myślał, że nasz program jest wygaszaczem
ekranu.
var L:longbool;

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

128. Jak ukryć lub pokazać pasek stanu?
Oto dwa kody ukazujące chowanie i pokazywanie paska stanu:
{ ukrywanie paska }
var
H : THandle;
wClass : array[0..50] of Char;
begin
StrPCopy(@wClass[0], 'Shell_TrayWnd');
H := FindWindow(@wClass[0], nil);
ShowWindow(H, SW_HIDE);
{ pokazywania paska }
var
H : THandle;
wClass : array[0..50] of Char;
begin
StrPCopy(@wClass[0], 'Shell_TrayWnd');
H := FindWindow(@wClass[0], nil);
ShowWindow(H, SW_RESTORE);


129. Jak zarejestrować skrót klawiaturowy dla całego systemu?
Czasami chcielibyśmy, aby skrót klawiatury był skojarzony z naszą
aplikację - np. po kliknięciu kombinacji: Ctrl + F10 nasza aplikacja ma
wykonywać jakąś czynność.
Najpierw w procedurze "OnCreate" należy wpisać:
{ Ta funkcja rejestruje skrót: Ctrl + F4 dla naszej aplikacji }
RegisterHotKey(Form1.Handle, $0001, MOD_CONTROL, VK_F4);
Teraz w procedurze "OnClose" musisz wpisać:
{ zwolnienie skrotu w systemi }
UnregisterHotKey(Form1.Handle, $0001);
No i w końcu deklaracja samej obsługi skrótu. W sekcji "private" dopisz
taką linie:
procedure wm_HOTKEY(var Msg:TMessage);message WM_HOTKEY;
Jest to komunikat "przechwytujący" skróty klawiaturowe. Najedź na niego
kursorem myszy i wciśnij: Ctrl + Shift + C. Wpisz taką deklarację
procedury:
if Msg.WParam = $0001 then
{ reakcja na skrót klawiszowy }
Application.Restore; // przywrócenie aplikacji


130. Jak narysować tekst w pionie?
Posłuż się takim kodem:
procedure TForm1.Button1Click(Sender: TObject);
var
LF : TLogFont;
begin
Canvas.Font.Size := 24;
GetObject(Canvas.Font.Handle, SizeOf(TLogFont), @lf);

lf.lfEscapement := 90 * 10;
lf.lfOutPrecision := OUT_TT_ONLY_PRECIS;

Canvas.Font.Handle := CreateFontIndirect(LF);

SetGraphicsMode(Canvas.Handle, GM_ADVANCED);
Canvas.Brush.Style := bsClear;

Canvas.TextOut(
20, 200, 'Hello World!');
end;


131. Jak przejść w stan oczekiwania?

SetSystemPowerState(true, true);


132. Jak usunąć moją aplikację z listy znajdującej się po naciśnięciu klawiszy: Ctrl + Alt + Del?
W sekcji "Interface" dodaj linię:
function RegisterServiceProcess(dwProcessId,dwType:dword):
Integer;stdcall;external 'kernel32.dll'

Teraz możesz napisać:
RegisterServiceProcess(GetCurrentProcessID, 1);




133. Jak odświeżyć widok pulpitu?

UpdateWindow(GetDesktopWindow);


134. Jak wyświetlić Windowsowe białe okno informacją o błędzie?
Poniższe polecenie wyświetla okno na białym tle z przyciskiem "Zamknij"
informujące o jakimś błędzie:
FatalAppExit(0, 'Zaistniał jakiś błąd');



135. Jak sprawdzić, czy użytkownik jest w Internecie?
Ta funkcja nie wszystkim działa więc....
W sekcji "Interface" dodaj nagłówek:

function InetIsOffline(Flag: Integer): Boolean; stdcall;
external 'URL.DLL';
Teraz w procedurze:
if InetIsOffline(0) then
ShowMessage('Jestem offline') else
ShowMessage('Jestem online');


136. Jak wykryć połączenie z netem?
U mnie działa taki kod:
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.


137. Jak wywołać okno połączenia Internetowego?

WinExec('rundll32.exe rnaui.dll,RnaDial TP SA',sw_show);
Gdzie TP SA to nazwa połączenia.


138. Jak uzyskać listę plików ( EXE) uruchomionych w systemie?
Trzeba w tym celu skorzystać z nisko poziomowych funkcji API:
uses TlHelp32;

procedure TForm1.btnAddEXEClick(Sender: TObject);
var
_HWND : THandle;
Proc : TProcessEntry32;
begin
_HWND := CreateToolHelp32SnapShot(TH32CS_SNAPALL,0);

Proc.dwSize:=SizeOf(Proc); // okresl rozmiar struktory

if Integer(Process32First(_HWND, Proc)) <> 0 then
repeat
ListBox1.Items.Add(Proc.szExeFile); // dodaje sciezkie pliku do ListBox'a
until Integer(Process32Next(_HWND, Proc)) = 0; // dopoki wartosc nie osiagnie 0

CloseHandle(_HWND);
end;


139. Jak usunąć plik do kosza?
Przede wszystkim do listy uses musisz dodać słowo ShellAPI. Teraz w
procedurze:
var
R : TSHFileOpStruct;
begin
with R do
begin
Wnd:=Handle; // oznaczenie uchwytu
wFunc := FO_DELETE;// opcja
pFrom:='c:\kody.html'; // z pliku
fFlags := FOF_ALLOWUNDO;
end;
SHFileOperation(R);



140. Jak dodać pozycję do menu jeżeli kliknie się na ikonę aplikacji na pasku zadań?
Jeżeli program jest uruchomiony i kliniesz prawym przyciskiem na na
ikonę programu to rozwinie się menu ze standardowymi opcjami ( Zamknij,
Minimalizuj itp. ). Można dodać tam swoją pozycje - wystarczy odwołać
się do WinAPI.
Umieść deklarację nowej procedury:
private
procedure WMNewPos(var Msg : TMsg; var Handle : Boolean);
Teraz definicja powinna wyglądać tak:
procedure TForm1.WMNewPos(var Msg: TMsg; var Handle: Boolean);
begin
if (Msg.message = WM_SYSCOMMAND) and (Msg.wParam = 101) then
ShowMessage('Cze!');
Handle := True;
end;
To była obsługa naszej nowej pozycje - wyświetli się okno z informacją.
Teraz wygeneruj procedurę OnCreate:
procedure TForm1.FormCreate(Sender: TObject);
begin
AppendMenu(
GetSystemMenu(Application.Handle, FALSE), MF_STRING, 101, 'Kliknij mnie!' );
Application.OnMessage := WMNewPos;
end;




141. Jak zrobić w RichEdit indeks dolny lub górny? ( tak jak w Wordzie ).
Przede wszystkim do listy modułów ( uses ) musisz dodać "RichEdit".
procedure TForm1.btnIndexClick(Sender: TObject);
var
CharFormat : TCharFormat;
begin
ZeroMemory(@CharFormat, SizeOf(TCharFormat)); // zerowanie pamieci
with CharFormat do
begin
cbSize := SizeOf(TCharFormat); // przydziel pamiec
RichEdit.Perform(EM_GETCHARFORMAT, 1, LParam(@CharFormat));
yHeight:=Round(yHeight*0.7); // wysokosc
yOffset:=Round(yHeight*0.3); // polozenie

RichEdit.Perform(EM_SETCHARFORMAT, wParam(SCF_SELECTION), LParam(@CharFormat));
end;
RichEdit.SetFocus;
RichEdit.SelLength := 0;
end;
Najpierw pobierane są dotychcczasowe ustawienia czcionki, a następnie do
wysokości czcionki dodawane jest położenie ( yOffset ). Później nowa
wartość jest przypisywana komponentowi. Jeżeli chcesz mieć indeks dolny
musisz nadać parametrowu yOffset wartość ujemną - jeżeli chcesz żeby
było tak jak wczęsniej musisz nadać wartość zerową.


142. Jak włączyć lub wyłączyć diody klawiszy NumLock, CapsLock?

VK_CAPITAL - caps lock
VK_SCROLL - scroll lock
VK_NUMLOCK - num lock
Oto kod:
const
ON = 1;
OFF = 2;
var
KS : TKeyboardState;
begin
GetKeyboardState(KS);
KS[VK_SCROLL] := ON;
SetKeyboardState(KS);
Ten kod może nie zadziałać w Win 2000/NT. Oto kod odpowiedni dla tych
platform:
keybd_event(VK_NUMLOCK, $45, KEYEVENTF_EXTENDEDKEY or 0, 0);
keybd_event(VK_NUMLOCK, $45, KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0);



143. Jak zapisać zawartość schowka do pliku, i zawartość pliku do schowka?
Zapisywanie zawartości do pliku:
uses ClipBrd;

procedure TForm1.Button1Click(Sender: TObject);
var
TF : TextFile;
begin
AssignFile(TF, 'C:\Clipboard.txt');
try
Rewrite(TF);
Writeln(TF, ClipBoard.AsText);
finally
CloseFile(TF);
end;
end;
Kopiowanie zawartości pliku do schowka:
procedure TForm1.Button2Click(Sender: TObject);
var
TF : TextFile;
S : String;
begin
AssignFile(TF, 'C:\Clipboard.txt');
try
Reset(TF);
Readln(TF, S);
ClipBoard.AsText := S;
finally
CloseFile(TF);
end;
end;

144. Jak załadować obrazek ze schowka do komponentu Image?
uses Clipbrd;

procedure TForm1.Button1Click(Sender: TObject);
begin
Image1.Picture.LoadFromClipboardFormat(CF_BITMAP, ClipBoard.GetAsHandle(CF_BITMAP), 0);
end;


145. Jak uruchomić wygaszacz ekranu?
SendMessage(Handle, WM_SYSCOMMAND, SC_SCREENSAVE, 0);


146. W jaki sposób pokazać okno kopiowania z dyskietki na dyskietkę?
WinExec('rundll32 diskcopy,DiskCopyRunDll', SW_SHOWNORMAL);


147. Co zrobić, gdy nie chcę aby na pasku zadań wyświetlona była "belka" formy wywołanej z DLL'a?
Czasem, gdy wywołujemy formę z DLL'a to na pasku zadań pojawia
się"belka" oznaczająca dany formularz. Co zrobić gdy nie chcemy, aby
takowa się pojawiała? Pomiędzy blok begin..end umieść takie linie:
Application.Handle := Form1.Handle;
Zakładając, że formularz nazywa się Form1. I będziesz jeszcze musiał
dodać moduł Forms do listy modułów.


22. Jak przechwycić adres WWW wpisany w przeglądarce?
Odpowiedź pochodzi z grupy dyskusyjnej: pl.comp.lang.delphi:
Function GetText(WindowHandle: hwnd):string;
var
txtLength : integer;
buffer: string;
begin
TxtLength := SendMessage(WindowHandle, WM_GETTEXTLENGTH, 0, 0);
txtlength := txtlength + 1;
setlength (buffer, txtlength);
sendmessage (WindowHandle,wm_gettext, txtlength, longint(@buffer[1]));
result := buffer;
end;

function GetURL:string;
var
ie,toolbar,combo,
comboboxex,edit,
worker,toolbarwindow:hwnd;
begin
ie := FindWindow(pchar('IEFrame'),nil);
worker := FindWindowEx(ie,0,'WorkerA',nil);
toolbar := FindWindowEx(worker,0,'rebarwindow32',nil);
comboboxex := FindWindowEx(toolbar, 0, 'comboboxex32', nil);
combo := FindWindowEx(comboboxex,0,'ComboBox',nil);
edit := FindWindowEx(combo,0,'Edit',nil);
toolbarwindow := FindWindowEx(comboboxex, 0, 'toolbarwindow32', nil);

result := GetText(edit);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
shomessage(GetURL);
end;

148. Jak założyć globalnego Hooka na klawiaturę?
Oto kod ukazujący jak założyc funkcję przechwytująca na klawiaturę. W
interface:
var MainHook : HHOOK;

function KeyHook(Code: Integer; wParam : WPARAM; lParam : LPARAM): Longint; stdcall;
A w Implementation:
function KeyHook(Code: Integer; wParam : WPARAM; lParam : LPARAM): Longint; stdcall;
var
Buffer: TEventMsg;
begin
result := 0 ;
Buffer := PEventMsg(lParam)^;
if Buffer.message = wm_KeyDown then
Form1.Memo1.Text := Form1.Memo1.Text + chr(Buffer.paraml);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
MainHook := SetWindowsHookEx(wh_JournalRecord, KeyHook, HInstance, 0);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
UnhookWindowsHookEx(MainHook);
end;


149. Jak pobrać częstotliwość taktowania procesora?
Oto procedura:
function CheckCPUSpeed: integer;
const
DelayTime = 500;
var
TimerHi, TimerLo: DWORD;
PriorityClass, Priority: integer;
begin
PriorityClass := GetPriorityClass(GetCurrentProcess);
Priority := GetThreadPriority(GetCurrentThread);

SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);

Sleep(10);
asm
dw 310Fh // rdtsc
mov TimerLo, eax
mov TimerHi, edx
end;
Sleep(DelayTime);
asm
dw 310Fh // rdtsc
sub eax, TimerLo
sbb edx, TimerHi
mov TimerLo, eax
mov TimerHi, edx
end;

SetThreadPriority(GetCurrentThread, Priority);
SetPriorityClass(GetCurrentProcess, PriorityClass);

Result := integer(Round((TimerLo / (1000.0 * DelayTime))));
end;
ShowMessage(IntToStr(CheckCPUSpeed) + ' MHz');




150. Rrejestrowanie typu pliku
Oto gotowa procedura służąca do rejestracji pliku:
procedure RegisterFileType( Extension, TypeName, OpenFile, DDEMacro, DDEApp, Icon,
Tip: string );
var s : string;
begin
if ( Extension = '' ) or ( TypeName = '' ) then
raise Exception.Create(CInvalidFileType);
with TRegistry.Create do
try
RootKey := HKEY_CLASSES_ROOT;
if OpenKey( '\.' + Extension, false ) then
begin
s := ReadString( '' );
if s <> TypeName then
begin
if OpenKey( '\.' + Extension + '\UndoClass', true ) then
begin
WriteString( '', s );
end {else raise Exception.Create( CNoBackupKeyCreate );
end;
CloseKey;
end;
if OpenKey( '.' + Extension, true ) then
begin
WriteString( '', TypeName );
CloseKey;
end;
if OpenKey( TypeName, True ) then
begin
WriteString('',Tip);
CloseKey;
end;
if OpenKey( '\' + TypeName + '\DefaultIcon', true ) then
begin
WriteString('',Icon);
CloseKey;
end;
if OpenKey( '\' + TypeName + '\shell\open\command', true ) then
begin
WriteString( '', OpenFile + ' "%1"' );
CloseKey;
end {else raise Exception.Create( CNoTypeKeyCreate )};
if ( DDEMacro <> '' ) and ( DDEApp <> '' ) then
begin
if OpenKey( '\' + TypeName + '\shell\open\ddeexec\Application', true ) then
begin
WriteString( '', DDEApp );
CloseKey;
end {else raise Exception.Create( CNoDDEAppKeyCreate )};
if OpenKey( '\' + TypeName + '\shell\open\ddeexec', true ) then
begin
WriteString( '', DDEMacro );
CloseKey;
end {else raise Exception.Create( CNoDDEKeyCreate )};
end;
SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);
finally
Free;
end;
end;


A teraz kilka objaśnień do powyższej procki :

Extension - w tym parametrze zawarte jest rozszerzenie pliku np. htm
TypeName - nazwa typu pliku np. dla pliku htm może to być htmfile, choć nazwa może być dowolna
OpenFile - ścieżka dostępu do aplikacji otwierającej plik, jeżeli ma być to nasz program to możemy użyć wyrażenia Application.ExeName, które zawsze będzie wskazywało aktualną ścieżkę dostępu do programu.
DDEMacro - ten parametr może pozostać pusty, no chyba, że twoja aplikacja korzysta z DDE przy otwieraniu plików ( tym przypadku najlepiej wpisać %1).
DDEApp - tak jak powyżej, z tym że jako parametr należy wpisać nazwę projektu, czyli pliku dpr.
Icon - ikona, która będzie widoczna w eksploratorze
Tip - opis typu pliku, który pojawi się w eksploratorze
Uwaga! Procedura wykrywa, czy dane rozszerzenie jest już zarejestrowane, jeżeli tak to tworzy klucz "UndoClass", w którym tworzona zostaje wartość określająca poprzednie ustawienia. Nie będę tutaj się rozwodził nad strukturą rejestru, bo to temat na dość spory artykuł.

Jeżeli chcesz się dowiedzieć po co i w jakim celu używa się DDE przy otwieraniu plików zobacz pytanie 43.
Dodanie ikony do traya można rozwiązać na dwa sposoby:

151. Wwewalenia czegoś do systraya
W odpowiedni sposób zmodyfikować kod głównej formy:

Do sekcji uses należy dodać moduł ShellAPI.
Do sekcji private dodaj:

IconNotifyData : TNotifyIconData;
procedure WndProc(var Msg : TMessage); override;
W zdarzeniu OnCreate wpisz kod:

with IconNotifyData do
begin
hIcon:=Application.Icon.Handle;
uCallbackMessage:=WM_USER+1;
cbSize:=SizeOf(IconNotifyData);
Wnd:=Handle;
uID:=100;
uFlags:=NIF_MESSAGE+NIF_ICON+NIF_TIP;
end;
// Kopiowanie tytułu aplikacji jako "dymek"
StrPCopy(IconNotifyData.szTip, Application.Title);

// Dodawanie ikony do traya
Shell_NotifyIcon(NIM_ADD,@IconNotifyData);

Procedure "WndProc" trzeba uzupełnić o ten kod:

procedure TMain.WndProc(var Msg : TMessage);
var
p : TPoint;
begin
{
Ta procedura służy do przechwytywania komunikatów po
naciśnięciu przycisku w obrębie ikony.
}
//Naciśnięto prawy przycisk myszy
if (Msg.Msg=WM_USER+1) and (Msg.lParam = WM_RBUTTONDOWN) then
begin
//Pobranie pozycji kursora myszki
GetCursorPos(p);
//Wyswietlenie menu
TrayMenu.Popup(p.x, p.y);
end;
//Jezeli nacisnieto lewy przycisk nastepuje wyswietlenie formy
if Msg.LParam = WM_LBUTTONDOWN then
MainFrm.Show;
inherited;
end;
W procedurze zamykającej program należy dopisać linijkę kodu, któru będzie odpowiedzialna z usunięcie ikony z traya:

Shell_NotifyIcon(NIM_DELETE, @IconNotifyData);

lub dodać komponent TTrayIcon
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,481 unikalne wizyty